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INTRODUCTION 


The STARS-2P program performs a significant amount of calculations prior 
to the complete processing of all data. Thus data errors or inconsistencies 
usually cause a run to terminate after the first data error is encountered. 
To overcome the resulting problem of requiring several computer runs to 
debug data, a special data debugging package called SAT-lP was created. 

The program was written exclusively in FORERAN IV for the IBM 370-165 
computer, and then converted to the UNIVAC 1108. The core utilization of 
the program is 32,000 words. 
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SECTION 1 


SATELLITE-IP PROGRAM 

1.1 INPUT : The sole purpose of the SAT-IP program is data debugging 

of the STARS -2 P program input data deck. Therefore the input data 
is identical to that described for the STARS program (Ref. l), 
with one exception to be discussed below. For this purpose the 
dash separator cards, which are actually required only for data 
separation in the SATELLITE program, are accepted also by the 
STARS program. 

The one data change involves the first card of the data deck, which 
in the STARS program is an arbitrary alphanumeric card. For the 
SAT-IP program this card is: 

I. Title Card Column Format 

A. Alphameric title (submission description) 1-60 15A4 

B. Scale Extent 61-70 F10.0 

This number will be used as the scale 

extent in the graphics output of the 
SATELLITE program. For example if the 
input number is 3000., the scale for 
all the diagrams will be set (square 
scale is used) so that 3,000.0 fits 
properly on 8 in. paper. A "default" 
option to this input is also available. 

If no scale extent is input, the program 
will size each region topology diagram 
on a square scale to best fit that 
region, resulting in different scales 
for different regions. 

All other input remains unchanged from the STARS-2P program. 
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1.2 


OUTPUT: The SAT-1P program functions basically are the following; 


A. Check all STARS -2P input data for consistency. 

B. Check all STARS-2P input data for possibilities of causing "divide 
by zero" errors. 

C. Check shell idealizations by providing exact plots of input points 
and/or shapes, and topology, thus allowing the user to locate 
gaps or other types of errors. 

D. _ Check spellings on alphameric clues, and where possible, format 

errors. In the latter case, no attempt has been made to override 
systems automatic terminations due to format inconsistencies. 
However, the use of the dash separator cards often allows further 
checking; to proceed. The dash separator cards also overcome user 
errors in setting input table lengths. 

Many of the errors encountered in the STARS -2P data deck will not 
affect the idealization plotting capability of the SAT-1P program. 
In cases where plotting is affected, as much plotting as possible 
will be accomplished before termination. Additional error 
messages will be provided directly on the charts. 


1.3 EXAMPLES, FLOW CHART, LISTING: The execution of one sample problem 

by the SAT-IP program is provided on the following pages. The data 
deck in this case is free of errors. For sample errors to be detected 
see the enclosed program listing or Reference 2. 
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SATEU.ITE-IP 


S T A R S - 2 P i P L A S T- 1 C im - 0*1 X- OE« US fcl N-S a 8 06* Ait- 


VERSION DATA OCTOBER t, 197* 


r O R I N F ORM ATIO N call 


V . S VAL B ONa S : — 

(S1&) S7S-7701 
P. O GILV I E 
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21 20 













I SOT 


ALUM 


SING 


TMJC 


NOTH 


KINE. 


7 * 100000*00 • 2 * 10000*01 

• 2 * 1 5000*00 > 2*1 5000*00 



2 0 III 


H 0 I I I 



• 1005000*08 *0000000 *0000000 *0000000 *0000000 


• 3200000*00 *0000000 


•0000000 


•0000000 






•ooooooo 


•ooooooo 


• ooooooo 


>0000000 


•ooooooo 


• 1683 * 100*05 *0000000 <0000000 *0000000 *0000000 




NO 0ETEC T *BI E ERRORS found. 














8 



REGION NUMBER 


1 SEGMENTS 


JOB NO 451026 PAGE 

0 LINKS 


laaBBBaBBaBaBBBBBBBBaBBflBBBBBBBBflBBBBBBBBBBBaBBBBBBBBBBBBBBBBBflBBBBaBBal 

l! B !B B !S BBBBBBBBBBBBBBBB BB BBB BBB BB B" aB B BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB l 

I ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■•■■■■■■■■■■■■■■■■■■I 

iBBBBBiaBaBBBBBBBBaBBBBBBaaBiBBBBBBBBBBSBBBBBBBBBBaaflBBBBBBBBBBBBBBBflBBl 

l!!SSSS! BBBBBBBBBBBBBBBBBB aa«" BB a B a B aaa BBBBBBBBBBBBBBBBBBBB " BBBBBBBBBBB l 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■I 

[■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■I 

l!!!!5i IBBBBBBBB > BBBBBBBB a>iB B aaa BBB a> B B BBBBBBBBBBBBBBBBBBBBBBBBB > BBnBB l 

laaaflBBBaBBBaiBBaBBBaBaBBaiBBBBaBflBBBBBaaBBaBflaaBflaBaBflBBBBBflaBBaBaaBBal 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■I 
ISS!S!! BBBBBBBBBBBBBBBBB aaa" B ""aa">* BB " BBBBBBBBBBBBBBBBBBBBBBBBBBBBB,BBB l 
l!!!!!! aBBBBBBBB i BBBBBBBBBB a BBBBBBBB i> B > BBBBBBBBBBBIIII » BBBBB > BBBBBIBMaBa l 
■•■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■I 
I ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■BiaaiiiaBaiamal 

laBBBBBaBBBBBBflBflBBBBaBBBBBBBaBBBBBBBBaflBaBBBBBBBBBBaflflBBBBBBBBBflBBBBaal 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■•■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■I 

laaflBBaBflBBBflBaflBBBBflBflflflBflflaBBBBflBBBBBflBflflBBBBBBaBBBBBBBBBBaaflBBBBflBBBl 

iBaaBBBaBBaBBBaflaaBBaBBBflBBBBaBBflBBBBaBiflBBBBBBBBBBBBBBBBBBBBBBBBaBflBflBl 

laaBBBBaflaBBaBBaBBaBBaBBaaBflaBBBflBaflBBBBBBBaBBBaBaBBaBBBaBflBBaaBBBBaBBBl 

iBBBBBBBBflBBBBRflBBBBBaBflaBBBBBBBBBBBBflBBBBBflBBBBBBBBBBBBBBBBBBflBBBBBBBBl 

I ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■I 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■•■■■■■■■■■■■■■■■■■■I 

l»5SS5SS55SSSS5SSSSSSSS55SSS5S5SS5SSS55SS5SSS55S5S5SSSS5SS5S5S55S5S5SSl 

I::::::::::;::::::;;::::::::::::::::::::::::::::::::::::::::;;:::::::: 

■■■■■■■■■■■■■■■■■■■a ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 


l5i!SSS BBBBBBBBaBBaBBBaaBaaaaaaaaaaaaaaBBBBBBBBaBBBBBBBBBBBBBBBa * gaBBBB l 

l aaaaaaaaaaa HiniBBaiMiiiBiHiiiaiiBiiHiiiiaiai a a aa iimiBiim aaaa aa| 
l5!!! B !! aaa ! aaa 9iai aa !9 aaBaBaaaaB H a MHiailHIIIIHiifiilMIIIIHIIIIIll 


■aaaaaa 


laaaaaaaaaaaaaaaaa: 


BBBBBBBBaBBBBBaBBBBBI 


■■■■■■I 


■19199911 


■BBBBBBBBBBBBBBBBBBI 


BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBflBBBBBBBBBBBBBBBBBBBBBBBBBBBB 


SiSinnSSS 


|aBBBBBBBflBBflBBBBBaBBBBBBBH»BBBHHBBBflaBBBBBBBBSSBBBBBBBBBBBBBBBBBBBal 

|bbbbbbbbbbbbbbbbbbbbbbbbbbbibbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb| 

|BBBBBBaaBIBBBBflBBBBflBBBBBBBIBBllliHMnnHHHHHHHHMHMHHMHHH 

|BBBBflBBBBBBBBBflBBBBBBflBBBBBBBBBBBBBBBBBBBBBBBBBflBBBBBBBBBBBBBBBBBBBBBB| 

|bbbbbibbbbbbbbbbibbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb| 

BBajMmBBBBBHBBBBBaBaiiii BaBBBBBBBBBBBBBI IBBaMBBaBaaBIBBBBBBal 

H ' • al 


9 hbrbbbbbbbbbbbbrbbbbbbbbbbbbbbbbbbbbbbbb| 
■BaBRSBBBBBBBBBRBBBBBBBBBBBRBBBBBBBBBBBBl 


l BBB Bi B 9BBBBBBBI 


BBBBBBBBBBI 


aBBBBBBBBBBBBBI 


■■■BBBBBBBBBBBBBBaBBBBBflBBBBBBBBBBBBBBBBBBBB999N9NHI9N9N9l99l9N99HHI 
BBBBBRBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBflBBBBBBBBBBBBB] 
BBBBBBBBBRBBBBBBBBBflBBBBBBflBBBBflBBRBBflBBBBBBflBBBBBBBBBBBBBBBBBBBBBBBBB| 


■ ■■■! 


IBBBIBBB1B999! 


1BBBBBI 


IBB I 


RADIUS OF REVOLUTION 
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region number 


1 segments 


JOB m 151026 PAGE 9 

0 LINKS 


■■■■■■■■■■I 


IUI 


BBBBBBBBBflBBBBBBBflflBBflBaBBBflBBBBBBBflBBBBBBBflBBBBBBBaBBBBBBBfl 

BBBflBBBBBBBflBflBBBBBBBflBBBBBBBBBBBBflBBBBBBBBBBBBBBBBaBflBBBaBfl 

■aBBaBBBBBBBflBBBBBBIBBBBflflflBflBBBBflflflflBBflBBBflBBflBBflBBflflBflBflBB 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■«■■■■■■■■■■■■■■■■■■ 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■I 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■a 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■a 

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■a 

■BBBBBBBBBBBiiBBBBBBBBflBBBBBaBBBBBBBBBBflBBaaBaaBaaBBaBBBBBBBB 

biiiiiiiiiiiiiiiiiiSiHiniiiiiiiiiifiiiiiiiiiiiiiiimiiiul 

Jniaaimaimal 
nniiiHiaumiiai 


paiiBiaaaniaiiiaaaHBBiHiaBiiHiaiiaaiiiiiiaNMHHMg 

iiBfllflBBBBBBBflBflBBIBBflflBflflflBBIIBflBBBBfllBflBBBnBBBBIBBBBBBBig 
BBBflaBBBBBBaBBaBaaBBBaBaBBaBBBflBBflBBBBaaBaBflaBBaaflaBBBaBBBBil 
iBaBBaBBBBBBBBBBBBBBBBBBBBBBBBBaBBBBBBBaaflaBBBaBBBBBBBBBBBBBM 
pBBBBBflBBBBBBBBflBBBBBBBBBBBBBflBBBBBBBBBBflBBBBBBBBflBBBBflBflflBBl 
|BBBBBBBIBflBBBBBBBBIBBBIIBBIBIIBIIIIBBBillBfllBBBIBIIBBBBUl3 
■BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBflBBBBBBflBBBBBBBBBBBBBBBl 

|bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb| 

■BBBBBBBBBBBBBBBBBBBBBBBBflBBBBBBBflflBBBBBBBBBBBBBBaBBBflBBBBBBl 

■BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBflBBl 

iBBBBBBBBBBflBBBBBBBBBBBBBBBflBBBBBBBBBBBBBaBBBBBBBBBBBBBBBBaBl 

BBBBBBflBBflBflBBBBBBBBBBBBBBBBBBBBflflflflBBflBflBBBBBBBBBBBBBBBBBBBl 

■BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBl 

iBBBBBBBBBBaBBBBBaaBaBaaBBBBaBflflBBaflBflBBBBBBBaBBaBBBBBBBBBaBl 

BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBflBBBBBBBBBl 

pBBBBBBBBBBaBBflBflBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBl 

BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBl 

■bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbI 

i’BaaBBBBBBflBBBBBBBBBBBBBBBBBBBaBBBBBBBBBBBBBBaBBBBBBBBBBBBaBl 
feBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBUIBBBBBBBBBBBBBBBBBBBBBBflBBl 
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The flow charts and listings of the SAT-1P program follow. The functions 
of the MAIN, GRAPH, ZPK)T and BOZO routines are explicit from the flow 
charts and need no further elaboration. The routines GEOMET, PLIEE and 
PLICO are discussed in Reference 3 . 
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MAIN 
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GRAPH 



RETURN 







RUN, //T STARSS , 1HNTS V440063, KSYJ0H8 IN2 14, 3, 500 

ASG.T PUR»T .SAVE05 

FREE TPF$. 

ASG.T TPF*,F/1/POS/10 

FOR, IS BL DAT A, BLOAT A 

BLOCK DATA 

COMMON /NAH1 / F ACE ( 4 ) , STRGO ( 7 ) , THERM (4 > , MATERC 3 ) , SESTABt 12 » 

DATA FACE/4HSING.4HEQUA, 4HUNEQ, 4H8LAN/ 

DATA STRGO/ 11. 0,13. 0, 21. 0, 31. G, 12.0, 14.0,15.0/ 

OATA THERM/4HTHST,4HN0TH,4HTHCN,4HtHIN/ 

DATA MATER/4HIS0T ,4H0RTH,4HST IF/ 

DATA SEGTAB/4HST 10, 4HTHIC.4HRWAF, 4HRWA1 .4HRWA2, 4HRWA 3 ,4H I SGI , 

1 4HISG2,4HISG3,4HST11,4HST12.4HST13/ 

END 

FOR, IS MAIN, MAIN 


C 

C 

C 

C 

C 

£ 

C 

C 

C 

c 

c 


******** ********************************************************** 


* * 

* SATSLLITE-1P * 

* * 

* . DATA DEBUGGING PROGRAM * 

* FOR * 

* STARS-2P (PLASTICITY) * 

* * 


****************************************************************** 


INTEGER SAVJTC,SAVSTP,SEGTAB, THICK, TYPE 

INTEGER XN 1 , XN2 , XN 

COMMON /NAM 1 / FACE! 4 ) , STRG0I7 ) , THERM (4 ) .MATER (3 ) , SEGTAB ( 12 ) 
COMMON/GRAPHJ/ST’ IC( 30 ) , ST PI 30 ) »GG1( 30 ) , GG2( 30),GG3(30), 

1 1 REGC , I SEG , NSEG.MGEOMt 30 ) , JL INK ( 30 > , IL INK ( 30 ) , ANGLNKI 30 ) ,NSKL 

2JJTI30), IJT( 30) 

COMMON /GPLOT/ ZZ (600 ) , RRADI600 ) , NPT,NZR,DX 

COMMON /SPLINS/ ANG, PS I ( 100 ) , R ADR ( 100 1 , Z I < 14 ) ,R I ( 14) ,NRZI N, 

1 POL Y( 10 ) ,NCOEF 

COMMON /TYGER/ XMAT(270, 10 ) ,L ST( 30 ) , ST ( 30,31 ) ,DUM ( 20 ) ,NSEGS ( 30) , 

C NRNG( 30 ) , JROW( 30, 30 ) ,KEL VN( 30 , 30 ) , JHAT ( 30 ,30 ) , 

0 NPP( 30, 30 ) ,NXM AT ( 20 ) .NREG.NOR ING.NMPT 

COMMON NERROR, ICOUNT 
DIMENSION STD( 10 ) , DLP ( 4 ) 

DIMENSION XDUM ( 6 ) , JCHK ( 30),LDEF(9> 

DIMENSION NRZN( 30), Z J ( 14, 30 ) , RJ ( 14,30) 

DIMENSIO N ANGL ( 30 ) , WORD! 3 ) , HARO( 3 ) 

EQUIVALENCE (DUM(1),D) 

DATA 0LIMTR/4H / , A/1HA/, B/ 1HB/ 

DATA WORD/ • PLAS ' , ' NL IN ' » ' NLPL ' / 

DATA HARD/ • I SOT , ,'KINE , » 'PERF'/ 

2000 FORMAT (20A4) 

2001 FORMAT 1 1X.20A4) 

I REGC * 1 

l READ! 5, 1999, END=555 ) DX.OUM 
1999 FORMAT(60X,F10.0,T1,20A4) 

WRITE (6, 1901 ) 

1901 FORMAT ( 1H1,20(/),60X, 1 2H SAT ELL I tE- 1P7//745X , 44H ST AKS-2 (PLASTICIT 
1Y) DATA DEBUGGING PR0GRAM////51X.3 1HVERSI0N DATA OCTOBER 1, 197 
23.281/) ,80X,35HF0R INFORMATION CALL V. SVALBONAS A T7X, 14H ( 516 > 5 

375-7701/103X,10HP. OGILVIE) 

WRITEI6, 1726) 

1726 FORMAT ( 1H 1 ) 

NIX * 0 

ICOUNT = 0 


100010 

100020 

100030 

100040 

100050 

100060 

100070 

100080 

100090 


200010 

200020 

200030 


200050 

200060 

200070 


200090 

200100 

200110 

200120 

200130 

200140 

200150 

200160 

200170 

200180 

200190 

200200 


200210 


200250 


200270 

200280 


200300 

200310 

200320 

200330 

200340 

200350 


200390 

200400 

200410 

200420 

200430 


14 


ICT = 1 



NPROB = 1 
DX = DX/8.0 

200440 


WR ITE ( 6, 2001 ) OUH 

RE AO <5, 1002) NREG.NSMAX.NMPT.L INPUT, NLDS ,CYC1 ,C YCP.NLR.RCYC , PRES, 

200450 


1 I WORD, OMEGA «OUH 


1002 

FORMAT (12, I3,3I2»F6.0*F4.0* 12 , 4X , 2F6.0* 17X, I 2,E 14. 7, T1,20A4) 



WR I TE ( 6 , 2001 ) DUM 

RE AD (5, 1008) AWORD, NX3, LOEF ,CYCG, DUM 

200490 

1008 

FORMAT ( A4, I6,10X,9II,2X,F4.0,T1,20A4) 
WRITE (6,2001 ) DUM 

200520 


DO 1500 J= 1 * 3 

IF ( WORD ( J l-AWORO ) 1500, 1501, 1500 


1500 

CONTINUE 

200550 

1501 

JPLS * J 



NLCASE = NPROB 

200630 


XN = 0 

200640 


NROW = 0 

200660 


KK = -1 

200670 


NSAVE * 0 

200680 


DO 13 1=1 ,NMPT 

200690 


KK = KK+2 

200700 


NXMAT(KK) = NROW* 1 

200710 


II = NROW+1 

200720 


RE ADI 5 , 1004 ) STD( I ) , TYPE, OUH 

200730 

*■* 

o 

s 

FORMAT ( 2 ( A4, 6X ) , T1 , 20A4 ) 

200740 


WRITE! 6 , 2001 ) DUM 

200750 


NROW = 27 
DO 11 L= l , 3 

200770 

ii 

IF (TYPE.EQ.MATER(L)) GO TO 12 

200780 


NERROR = 1 

200790 


CALL ETRAP 

200800 


STD( I ) = DLIMTR 

200810 


WR I TE ( 6, 223 ) 

200820 

223 

FORMAT (28X.103H* DUE TO INPUT ERROR IT IS IMPOSSIBLE TO CHECK TH 

200830 

IE FOLLOWING CARDS UP TO THE DASH-SEPARATOR CARD. */) 

200840 


GO TO 2 

200850 

12 

CONTINUE 

IF (L.EO.l) NROW = 7- 

200860 


IF (L.EQ.2) NROW = 17 
LLL = NS AVE*NROW 

200890 


READ! 5, 1005) ( ( XMAT! M, J ) , J= 1 , 10 ) ,M= I I ,LLL ) 

200900 

1005 

FORMAT ( 5E14. 7 ) 

200910 


WRITE (6, 1205) ( ( XMAT ( M, J ) , J= 1 , 10 ) , M= I I , LLL ) 

200920 

1205 

FORMAT! 1X.5E14.7) 

200930 


DO 608 M=3 ,10 

200940 


IF (XMAT(II,M-1) .LT.XMAT! II, M) 1 GO TO 608 

200950 


IF (XMAT ( II,M).EQ.O.O) GO TO 608 

200960 


NERROR = 32 

200970 


CALL ETRAP 

200980 


STD(I) = D 

200990 

608 

CONTINUE 



NROW = NSAVE+NROW 

201010 


NXMAT ( KK+1 ) = LLL 

201020 

13 

NSAVE = NROW 

201030 

2 

RE AD ( 5 ,2000 ) DUM 

201040 


WR ITE( 6, 2001 ) OUM 

201050 


IF (O.NE.OLIMTR) GO TO 2 

201060 


WR ITE ( 6 , 222 ) 

201070 

222 

FORMAT!/) 

201080 


DO 99 NRC=1, NREG 

201090 


15 




RE AD( 5 ,1003 ) NST, NKL , NR ING* DUM 


201100 

1003 

FORMAT(3I2*T1*20A4) 


201110 


WR ITE < 6, 2001 ) DUM 


201120 

NRNG(NRC) - NRING 
NSEGS ( NRC ) = NST 


IF (NRING. LE. 28) GO TO 214 


201130 


NERROR = 37 


201140 


CALL ETRAP 


201150 


WRITE (6, 996 ) NRC 


201160 

996 

FORMAT < /5X« ' * REGION NUMBER ',12,' 

*•///) 

201170 

214 

CONTINUE 


201180 


READ! 5, 1006 ) JRT IC, JRSTOP, DUM 


201190 

1006 

FORMAT (5X,2I5,T1,20A4) 


201200 


WR ITE( 6, 2001 ) DUM 


201210 


NSEG = NST 


201220 


NSC = 0 


201230 

101 

NSC = NSC*1 


201240 


NCHK = 0 

READ! 5» 1011 ) RGO , ANG , NL R S , DUM 


201250 

1011 

FORMAT (F2.0.A1, I2,T 1.20A4) 
WR ITE ( 6, 2001 ) DUM 


201280 

C 

GEOMETRY IDENTIFICATION SEARCH 


201290 


DO 504 1*1,7 


201300 

504 

IF ( RGO.EQ.STRGOI I ) ) GO TO 505 


201310 


NERROR = 2 


201320 


NCHK = 1 


201330 


CALL ETRAP 


201340 


WRITE (6,999) NRC, NSC 


201350 


I = 8 


201360 

505 

KGEOM = I 


201370 


MGEOM(NSC) = KGEOM 


201380 


IF (KGEOM. EQ. 5) WRITE(6, 1233) 


201390 

1233 

FORMATI/60X, 'NOTE - FOR PLOT ROUTINE 

A/B-1.5, N=0 WILL BE USED.'/) 

201400 


IF (RGO. NE. 14.0) GO TO 280 


201410 


ANGL(NSC) = ANG 


201420 


IF < ANG. EQ.A.OR. ANG.EQ.8 ) GO TO 280 


201430 


NERROR = 2 


201440 


NCHK = 1 


201450 


CALL ETRAP 


201460 


WR ITE ( 6, 999 ) NRC, NSC 


201470 

280 

CONTINUE 


201480 


RE AD (5, 1012) DTAU,D IFF, STEP, APEX, DUM 



1012 

FORMAT(3E14.1,3X,A4,T1,20A4) 




WR ITE ( 6, 200 1 ) DUM 


201510 


IF (RGO. EQ. 14.0) GO TO 180 


201520 


RE AD( 5 , 10 15 ) G1 ,G2 , G3, DUM 


201530 

1015 

FORMAT (3E 14. 1,T1,20A4) 


201540 


WRITE ( 6 , 200 1 ) DUM 


201550 


GGKNSC) = G1 


201560 


GG21NSC) =. G2 


201570 


GG3 ( NSC ) = G3 


201580 


GO TO 188 


201590 

180 

READ! 5, 182) NRZ IN , ( ZI ( J » ,R I ( J ) , J=1 , 3 ) 

,ZI (4) ,DUM 

201600 

182 

FORMAT ( 12, 7F 10.0, T1,20A4) 


201610 


NRZN(NSC) = NRZ IN 


201620 


IF (NRZIN.LE.14) GO TO 181 


20 1630 


WR ITE ( 6 , 2001 > DUM 


201640 


NERROR = 39 


201650 


NCHK = 1 


201660 


CALL ETRAP 


201670 


WRITE ( 6 , 223 ) 


201680 
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GO TO 3 

201690 

181 

IF ( NRZIN. LE. 31 GO TO 185 

201700 


IF (NRZIN. EQ. 4) REA0(5.186) RI(4) 

201710 

186 

FORMAT (7F10.0) 

201720 


IF (NRZIN. GT .4) REA0(5,186) R I ( 4 ) , ( Z 1 ( J ) »R I (J),J=5»NRZIN) 

201730 

185 

CONTINUE 

201740 


WRITE (6 >183) NRZIN, IZII J),RJ( J), J=1,NRZ IN) 

201750 

183 

FORMAT! IX, 12 ,7F 10 .4/ ( IX , 7F 10.4 )) 

201760 


DO 190 J=l, NRZIN 

201770 


ZJ(J.NSC) = ZI(J) 

201780 

190 

RJ(J.NSC) = R1IJI 

201790 

188 

CONTINUE 

RE AO (5, 1013) TYPE. HLAYR, SHEET, INTERP, RANKIN, HARDEN, NP.DUM 

201800 

1013 

FORMAT (6 t A4.6X ), 10X, I2,T1,20A4) 
WRITE! 6, 2001 ) DUM 

201830 


ICHK = 0 

201840 

C 

MATERIAL PROPERTY IDENTIFICATION 

201850 


00 501 l=l,NHPT 

201860 

501 

IF (HLAYR.EQ.STDII) ) GO TO 502 

201870 


NERROR = 4 

201880 


CALL ETRAP 

201890 


WR ITE ( 6, 999 ) NRC.NSC 

201900 


ICHK = 2 

201910 


I = NMPT ♦ 1 

201920 

502 

MAT = l 

201930 


JMAT ( NRC , NSC ) = HAT 
DO 506 1=1,3 

201940 

506 

IF (TYPE. EQ. MATER! I)) GO TO 507 

201950 


NERROR = 5 

201960 


CALL ETRAP 

201970 


WRITE 16,999) NRC.NSC 

201980 


I = 4 

201990 

507 

I TYPE = 1 

202000 


DO 512 1=1,3 


512 

IF (HARDEN. EQ. HARD! I) 1 GO TO 513 


NERROR = 26 
CALL ETRAP 


WR ITE ( 6, 999 ) NRC.NSC 


513 

CONTINUE 



DO 510 1=1,12 

202010 

510 

IF ( INTERP.EQ.SEGTAB! I ) ) GO TO 511 

202020 


NERROR = 6 

202030 


CALL ETRAP 

202040 


WRITE 16,999 ) NRC.NSC 

202050 


ICHK = 1 

202060 


I = 13 

202070 

511 

ISTTAB = I 

202080 


KLUE2 = l 

202090 


IF ( ISTTAB. GE. 3. AND. ISTTAB. LE. 6) KLUE2 = 2 

202100 


DO 508 1=1,4 

202110 

508 

IF (SHEET. EQ. FACE! I ) ) GO TO 509 

202120 


NERROR = 7 

202130 


CALL ETRAP 

202140 


WR ITE ( 6 , 999 ) NRC.NSC 

202150 


ICHK = 1 

202160 


I = 5 

202170 

509 

THICK = I 

202180 

C 

TEMPERATURE LOAD IDENTIFICATION 

202190 


DO 401 1=1,4 

202200 

401 

IF (RANKIN. EQ. THERM! I ) ) GO TO 402 

202210 


NERROR =8 

202220 


17 









CALL ETRAP 202230 

WRITE (6.999) NRC,NSC 202240 

1=5 202250 

402 KELVIN = I 202260 

KELVN(NRC.NSC) = KELVIN 

IF (NP.GE.2. AND.NP.LE.30 I GO TO 191 ' 202270 

NERROR = 3 202280 

NCHK =1 ------ 202290 

CALL ETRAP 202300 

WR ITE ( 6 1 999 ) NRC.NSC 202310 

999 F0RMAT(/5X,«* REGION NUMBER • , 1 2, 5X, • SEGMENT NUMBER M2,' *• 202320 

1 ///) - — 202330 

WR ITE< 6,223 ) j 202340 

GO TO 3 " ' 202350 

191 CONTINUE 202360 

NPP( NRC, NSC 1 = NP 

IF (ICHK.EO.ll WR1TE(6,223I 202370 

IF ( ICHK.EQ. 1) GO TO 3 " " ' ' “ ' 202380 


IWD = 1-IWORD 

NROW = 3-IWD 

IF (THICK. GT.l) NROW = THICK+3-2* IWD 
IF ( ISTTAB.EQ.l ) NROW = 14-3*IWD 
IF ( ISTTA8.EQ.3I NROW = 16-3*IWD 
IF ( ISTTAB.E0.4I NROW * 10-2*IWD 
IF ( ISTT AB.EQ.S I NROW = 12-3*IWD 


IF 

(ISTTAB.EQ.6) 

NROW = 

13-3* IWO 

IF 

( I STT AB.EQ.7 ) 

NROW = 

9-2*IWD 

IF 

( ISTTAB.E0.8 > 

NROW = 

1 1-3* IWO 

IF 

( I ST TAB . E0.9 ) 

NROW = 

12-3* IWD 


IF ( ISTTAB.EQ.10) NROW = 15-3*IWD 
IF (ISTTAB.EQ.il) NROW = 17-4*IWP 


IF ( ISTTAB.E0.12) NROW = 18-4*IWD 
JROW( NRC.NSC I = NROW 


IF ((ISTTAB.NE.1.AN0.ISTTAB.NE.3I.0R.JPLS.NE.2) GO TO 290 



NERROR = 40 



CALL ETRAP 



WRITE ( 6 » 999 1 NRC.NSC 


290 

CONTINUE 



00 901 I=i,NROW 

202520 


REA0(5, 10051 (ST( I, J) ,J=1,NP) 

202530 


WRITEI6.1205) ( ST ( I , J I , J= 1 , NP I 

202540 

901 

CONTINUE 

202550 


STIC(NSC) = ST ( 1 , 1 1 

202560 


STP(NSC) = ST(1,NP) 

202570 


IF ( G1 . EQ.O .0. ANO.KGEOM . EQ . 3 ) GO TO 902 

202580 


GO TO 903 

202590 

902 

S = ST ( 1 , 1 ) /ST( 1 , NP I 

202600 


IF (0. 01. LT.S. AND. S.LT. 100.0) GO TO 903 

202610 


NERROR = 33 

202620 


CALL ETRAP 

202630 


WR ITE ( 6. 998 ) NRC.NSC.LL 

202640 

903 

CONTINUE 



00 2108 LL=l»NP 

202660 


HO = 1.0 

202670 


T = 1.0 

202680 


GO TO (711, 600, 711, 32, 33, 34, 35, 36. 37, 28, 29, 30), ISTTAB 

nrf TTTTTB 

600 

GO TO (701, 702, 703), THICK 

202700 

703 

HO = ST ( 4,LL ) 

202710 

702 

T = ST ( 3 , LL ) 

202720 

701 

HI = ST ( 2, LL ) 

202730 


GO TO 714 

202740 
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711 

CONTINUE 

202750 


XK11 = ST< 2 » LL ) * 

202760 


XK12 = ST ( 3. LL ) 

202770 


XK22 = ST ( 4, LL ) 

202780 


XK33 = ST ( 5 » LL ) 

202790 


X011 = ST ( 6. LL ) 

202800 


X012 = ST 1 7, LL ) 

202810 


XD22 = ST(8»LL> 

202820 


XD33 = STI9.LL) 

202830 


XK21 = XK 12 

202840 


X021 = X012 

202850 


GO TO 814 

202860 

34 

HO * ST(IO.LL) 

202870 

33 

T = ST (9,LL ) 

202880 

32 

HI = ST ( 8 » LL ) 

202890 


GO TO 851 

202900 

37 

HO * STC9.LL) 

202910 

36 

T = ST18.LL) 

202920 

35 

HI = ST ( 7. LL ) 

202930 

851 

CONTINUE 

202940 


SPH = STI5.LL) 

202950 


IF I SPH. NE. 0.0) GO TO 714 

202960 


NERROR = 9 

202970 


CALL ETRAP 

202980 


WRITE ( 6 , 998 ) NRC.NSC.LL 

202990 


GO TO 714 

203000 

30 

HO * ST ( 14, LL ) 

203010 

29 

T » ST ( 13, LL ) 

203020 

28 

HI = ST ( 12, LL ) 

203030 


SPH * ST ( 10, LL ) 

203040 


STH = ST ( 11 , LL > 

203050 


IF ( STH. NE .0 .0 ) GO TO 850 

203060 


NERROR = 10 

203070 


CALL ETRAP 

203080 


WRITEI6.998I NRC.NSC.LL 

203090 

850 

IF (SPH. NE. 0.0) GO TO 714 

203100 


NERROR =11 

203110 


CALL ETRAP 

203120 


WRITE<6,998) NRC.NSC.LL 

203130 

714 

CONTINUE 

203140 


IF (HO.NE.O.O) GO TO 802 

203150 


NERROR = 12 

203160 


CALL ETRAP 

203170 


WRITE (6,998 ) NRC.NSC.LL 

2031B0 

802 

IF (T.NE.O.O) GO TO 801 

203190 


NERROR = 13 

203200 


CALL ETRAP 

203210 


WRITE(6,998 ) NRC.NSC.LL 

203220 

801 

IF (HI.NE.O.O) GO TO 814 

203230 


IF ( ISTTAB.EQ.6.0R. ISTTAB.EQ.9.0R. ISTTA8.EQ.12.0R.il STTAB . EQ.2. AND 

203240 

1 

..THICK. EG. 3) ) GO TO 710 

203250 


NERROR = 14 

203260 


GO TO 712 

203270 

710 

NERROR = 15 

203280 

712 

CALL ETRAP 

203290 


WRITEI6.998) NRC.NSC.LL 

203300 

814 

CONTINUE 

203310 


IF ( ITYPE.NE.3) GO TO 2108 

203320 


IF ( ISTT AB.NE. 1 . AND. ISTTA8 .NE .3 ) GO TO 2108 

203330 


IF (XKll.NE.O.O) GO TO 2101 

203340 


NERROR = 16 

203350 
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CALL ETRAP 

203360 


WRITE ( 6 , 998 ) NRC,NSC,LL 

203370 

2101 

IF (XK12.NE.0.0) GO TO 2104 

203380 


NERROR =17 

203390 


CALL ETRAP 

203400 


WR ITE ( 6 f 998 ) NRC.NSC.LL 

203410 

2104 

IF IXK21.NE.0.0) GO TO 2105 

203420 


NERROR = 18 

203430 


CALL ETRAP 

203440 


WRITE 1 6 » 998 ) NRC.NSC.LL 

203450 

2105 

IF (XK22.NE.0.0) GO TO 2106 

203460 


NERROR = 19 

203470 


CALL ETRAP 

203480 


WR ITE ( 6 1 998 ) NRC.NSC.LL 

203490 

2106 

IF ( XK33.NE . 0.0 ) GO TO 2109 

203500 


NERROR = 20 

203510 


CALL ETRAP 

203520 


WRITEI6.998) NRC.NSC.LL 

203530 

2109 

IF (X011.NE.0.0) GO TO 2110 

203540 


NERROR =21 

203550 


CALL ETRAP 

203560 


WR ITE (6.998 ) NRC.NSC.LL 

203570 

2110 

IF 1X012. NE.O.O) GO TO 2102 

203580 


NERROR = 22 

203590 


CALL ETRAP 

203600 


WRITE) 6,998 ) NRC.NSC.LL 

203610 

2102 

IF (X021. NE.O.O) GO TO 2103 

203620 


NERROR = 23 

203630 


CALL ETRAP 

203640 


WRITE 1 6 ,998 ) NRC.NSC.LL 

203650 

2103 

IF (XD22.NE.0.0) GO TO 2107 

203660 


NERROR = 24 

203670 


CALL ETRAP 

203680 


WRITE ( 6,998 ) NRC.NSC.LL 

203690 

2107 

IF (X033.NE.O.O) GO TO 2108 

203700 


NERROR = 25 

203710 


CALL ETRAP 

203720 


WRITE) 6,998 ) NRC.NSC.LL 

203730 

2108 

CONTINUE 

203740 


K = NROW+1 

203780 


JJ = 1 

203790 


JJJ = 6 

203800 


JT = JJ 

203840 


JTT = JJJ 

203850 


L = 0 

203860 


RE ADI 5, 1014) )LST)J),J = JJ, JJJI.DUM 

203870 

1014 

FORMAT16I1.T1.20A4) 

203880 


WR ITE ) 6 , 2001 ) DUM 

203890 


IF ILST1JJ)) 8031,19,20 

203900 

20 

L = LST(JJ) 

203910 

1026 

IF I (LST1 1) .NE.1.AND.LST1 JTJ.NE.l). AND. (KELVIN. EQ. 3. OR. KELVIN. EO. 4 

203970 

1)1 GO TO 1027 

203980 


GO TO 1028 

203990 

1027 

NERROR = 35 

204000^ 


CALL ETRAP 

204010 


WR ITE 1 6 , 999 ) NRC.NSC 


1028 

IF IILSTIl).NE.4.AN0.LST(JT).NE.4).AND.KELVIN.EQ.l) GO TO 1029 

204030 


GO TO 1025 

204040 

1029 

NERROR =35 

204050 


CALL ETRAP 

204060 


WRITE (6, 999) NRC.NSC 

204070 


20 



IF (L.NE.1.AN0.L.NE.4) GO TO 8031 


GO TO 19 
NERROR = 27 


CALL ETRAP 

WRITE ( 6 » 999 ) NRC.NSC 


WRITE(6,223) 
GO TO 3 


JJ * JJ*1 

IF (L. NE.O.ANO. KELVIN. EQ. 2) GO TO 8075 


GO TO 23 
NERROR = 35 


CALL ETRAP 

WRITE (6* 9991 NRCtNSC 


IF (LST(JJ)) 8032,22,21 
L = L+l 


IF (LST( JJI.NE.l) GO TO 8032 

IF (JJ.EQ.JJJ1 GO TO 24 

JJ = JJ+1 
GO TO 23 


NERROR = 27 
CALL ETRAP 


WR ITE ( 6 , 999 ) NRC.NSC 
WR ITE ( 6 , 223 ) 


GO TO 3 

IF (L.EQ.O) GO TO 71 


IF (ICHK.EQ.2.AN0.LST(JJ-5I.NE.0J WRITEI6.223) 
LY * K 


KK = K+L-l 
DO 72 M=K, KK 


RE ADI 5 , 1005 ) ( ST ( M, J ) , J= 1, NP) 
WR ITEI6, 1205 ) ( ST (M, J ) , J*1»NP ) 


CONTINUE 

CONTINUE 


CONTINUE 

READ! 5,591) IS, SAVJTC, SAVSTP *DUM 


FORMAT (3I5,T1,20A4) 
WRITE (6,2001 ) DUM 


IJTINSCI = SAVJTC 
JJT(NSC) = SAVSTP 


THE UPDATED INTERPOLATED VALUES OF THE MATERIAL PROPERTY COEFFIC 
I ENTS ARE FOUND IN THE XMAT TABLE AND STORED IN THE XLAYER ARRAY 
IF (LSTm.EQ.O! GO TO 3 

IF (ICHK.EQ.2I GO TO 3 

IF (KELVIN. NE. 5) GO TO 125 

IF ( LST ( 1I.EQ.1) KELVIN => 3 

IF (LST(1).EQ.4> KELVIN = 1 

CONTINUE 

DO 123 LL= 1, NP 
L= ( MAT-1 ) *2+1 
1 1 =NXMAT ( L I 
I I I = NXMAT ( L + l J 


204080 


204090 

204100 


204110 

204120 


204130 

204140 


204150 

204160 


204170 

204180 


204190 

204200 


204210 

204220 


204230 

204240 

204250 

204260 


204270 

204280 


204290 

204300 


204310 

204320 


204330 

204340 


204350 

204360 


204370 

204380 


204390 


204460 

204470 


204480 

204490 


204500 

204510 


204520 

204530 

204550 

204560 


204590 

204600 

204610 

204620 

204630 



DO 104 I = 2,10 

IF ( ARG-XMAT ( 1 1 , 1 ) ) 121,123,104 
IF 1 1 -2 ! 8007,8007, 123 
NERROR = 28 


204710 

204720 

204730 
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CALL ETRAP 

209790 


WR ITE 1 6 » 998 ) NRC * NSC»LL 

209750 

998 

FORMAT ( /5 X * • * REGION NUMBER ', I 2, 5X, ' SEGMENT NUMBER ',I2,5X, 

209760 


1 'SEGMENT GEOMETRY TA8J.E ITEM ',12,' *'///) 

209770 


GO TO 123 

209780 

109 

CONTINUE 

209790 


NERROR = 29 

209800 


CALL ETRAP 

209810 


WRITE (6 » 998 ) NRC, NSC, LL 

209820 

123 

CONTINUE 

209830 

3 

RE AOI 5, 2000 ) OUM 

209890 


WRITE! 6,2001 ) OUM 

209850 


IF (O.NE.OLIMTRI GO TO 3 

209860 


WR ITE 1 6 , 222 ) 

209870 


JCHK(NSC) = NCHK 

209880 


IF INSC.LT.NSEG) GO TO 101 

209890 


NSC = 0 

209900 


IF (NRING.EO.O) GO TO 210 

209910 


00 211 1=1 , NRING 

209920 


READ! 5, 720) JTNO, I XOUMIJ ) , J=1 , 5 ) , DUM 

209930 

720 

FORMAT! I2,5E19.7,T1,20A9) 

209990 

WRITE(6,2001 ) DUM 

RE ADI 5, 723 ) (XDUM(J),J=1,5),DUM 

723 

FORMAT! A9.2X.9E 19.7, T1.20A9) 
WRITE 16,2001) OUM 

209950 


READ! 5,721 ) XDUM.OUM 

209960 

721 

FORMAT !6E12.5,T1,20A9) 

209970 


WRI TE ! 6 ,2001 ) DUM 

209980 


IF IXDUMI2)) 780,780,781 

209990 

780 

WRITE 16, 782 ) 

205000 

782 

FORMAT!/ 9X , ' THE RING CENTROID RADIUS IS ZERO.'/) 

205010 


1 COUNT = ICOUNT+l 

205020 

781 

CONTINUE 

205030 


READ! 5,722) !X0UM(J),J=1,9) , HARDEN, OUM 


722 

F0RMAT19E19.7,9X,A9,TI,20A9) 



WRITE 16, 2001 ) DUM 
DO 517 J=l,3 

205060 

517 

IF IHARDEN.EQ.HARDI J) ) GO TO 518 
NERROR = 36 



CALL ETRAP 


518 

CONTINUE 



READ! 5,721) XDUM.OUM 


211 

WR ITE 1 6 , 2001 ) DUM 

205090 

680 

READ (5,2000 ) DUM 

205100 


WR ITE ! 6 , 2001 ) DUM 

205110 


IF IO.NE.DLIMTR) GO TO 680 

205120 


WRITE (6,222 ) 

205130 

210 

CONTINUE 

205190 


NSKL = NKL 

205150 


IF (NSKL.EQ.O) GO TO 95 

205160 


00 103 NRIG= l.NSKL 

205170 


RE AD! 5 , 503 ) JDEP, J IND, ANGL E ,OUM 

205180 

503 

FORMAT (2I2.E 19. 7,T1,20A9) 

205190 


WR ITE ( 6, 2001 ) DUM 

205200 


JLINK(NRIG) = JDEP 

205210 


I L INK! NR IG ) = JIND 

M 1 1 1 1 1 I 


ANGLNK(NRIG) = ANGLE 

205230 


IF ( JINO.LT.JDEP) GO TO 103 

205290 


NERROR = 30 

205250 


CALL ETRAP 

205260 

103 

CONTINUE 

205270 


22 









READ! 5, 2000 ) OUM 


WRITE! 6, 2001 ) DUN 
IF (D.NE.OLIMTR) GO TO 4 


WR ITE (6* 222 ) 

NSEG * NST 

NLINK = NKL 

00 3030 1SEG = 1« NS EG 

NCHK = JCHKI ISEG) 

KSEG = ISEG 


IF ( HGEON! ISEGI.NE.6) GO TO 145 

ANG = ANGLI ISEG) 

NRZIN = NRZN(ISEG) 

IF (NRZIN. GE. 151 GO TO 195 


00 192 1=1, NRZIN 
Z I ( 1 1 = ZJ( I, ISEG) 


Rill) = RJ( I , ISEG) 
CONTINUE 


CALL GRAPH INCHK.NRC) 

IF ( N CHK. EQ. 1 ) G O T O 3031 

CONTINUE 
NZR = NRC 


JCLUE = 

IF (NCHK. EQ.l. AND. KSEG. EQ.l) JCLUE = 


IF (NCHK.EQ. l.AND.KSEG.GT. 1 ) JCLUE = 
CALL ZPLOT (JCLUE) 


CONTINUE 

RE Ap( 5 ,60 1 ) NOJ, NORING, NLINK, DUH 


F0RMAT(3I5,T1,20A4) 
WR ITE ( 6, 2001 ) OUN 


IF (NORING. LE. 28) GO TO 750 

NERROR = 38 

CALL ETRAP 
CONTINUE 


IF (NORING. EQ.O) GO TO 751 
DO 752 1=1, NORING 


RE AD( 5 , 720 ) JTNO, ( XOUM( J ) , J= 1 , 5 ) , DUN 
WR ITE ( 6 , 2001 ) DUN 


READ (5,723 ) ( XDUM( J ) , J= 1 ,5 ) , OUN 
WRITE (6,2001) DUN 6 


READ< 5,721 ) XDUM.DUN 
WR ITE (6,2001 ) DUN 


IF (X0UM<2)) 783,783,784 

WR ITE ( 6, 782 ) 

ICOUNT = ICOUNT+1 
CONTINUE 


READ! 5,722) (XDUN( J >, J= l, 4 ), HARDEN, OUN 

WR ITE(6, 2001 ) DUN 

DO 519 J-1,3 

IF (HARDEN. EQ. HARD( J) ) GO TO 520 

NERROR =36 
CALL ETRAP 


CONTINUE 

RE AD ( 5, 721 ) XDUN,DUN 


WR ITE (6 • 2001 ) OUN 
RE AO (5, 2000) DUN 


WR ITE ( 6, 2001 ) DUN 
IF (O.NE.OLINTR) GO TO 681 


WRITE (6,222 ) 

CONTINUE 

IF (NLINK. EQ.O) GO TO 3108 

00 602 NRIG=1, NLINK 


205280 


205290 

205300 


205310 

205320 

205330 

205340 

205350 

205360 


205370 

205380 

205390 

205400 


205410 

205420 


205430 

205440 


205450 

205460 

205470 

205480 


205490 

205500 


205510 

205520 


205530 

205540 


205550 

205560 


205570 

205580 

205590 

205600 


205610 

205620 


205630 

205640 


205650 

205660 


205670 

205680 

205690 

205700 


205740 

205750 


205760 

205770 


205780 

205790 

205800 

205810 


23 




RE AD! 5 ,603 ) JD, J I , COTAN , DUM 


205820 

603 FORMAT I2I2*E14.7,T1»20A4) 


205830 

WRITE! 6 * 2001 ) DUM 


205840 

LST(NRIG) = JO 


205850 

IF (NRIG.EQ.l) GO TO 605 


205860 

IF (JOD.LT.JD) GO TO 605 


205870 

NERROR = 31 


205880 

CALL ETRAP 


205890 

IF (JDD.GE.JD) GO TO 602 


205900 

605 JDD = JO 


205910 

602 CONTINUE 


205920 

5 READ! 5, 2000) OUM 


205930 

WRITE! 6, 2001 ) DUM 


205940 

IF ID.NE.DLIMTR) GO TO 5 


205950 

WRITE! 6,222) 


205960 

3108 CONTINUE 


205970 

DO 109 J=1,N0J 


205980 

RE AD! 5 « 1 10 ) JN.DLP, ANGLE, DUM 


205990 

110 FORMAT! I 2, 4F2.0, E14. 1 , T 1 . 20A4 ) 


206000 

WR I TE ( 6 > 2001 ) OUM 


206010 

IF INLINK. EQ.O) GO TO 109 


206020 

DO 130 N*1 , NL INK 


206030 

IF ( JN.EQ.LSTIN) ) GO TO 132 


206040 

130 CONTINUE 


206050 

GO TO 109 


206060 

132 DO 131 1=1,4 


206070 

IF IDLPI I ) .EQ.O.O) GO TO 131 


206080 

NERROR = 34 


206090 

CALL ETRAP 


206100 

GO TO 109 


206110 

131 CONTINUE 


206120 

109 CONTINUE 


206130 

6 RE AD 1 5 ,2000 ) OUM 


206140 

WRITE! 6 , 200 1 ) OUM 


206150 

IF ID.NE.DLIMTR) GO TO 6 


206160 

WRITE 1 6,222 ) 


206170 

READ! 5, 302 ) LINLOD, DUM 


206190 

302 FORMAT! 14, T1.20A4) 


206200 

WRITE 16, 2001 ) DUM 


206210 

IF (LINLOD. EQ.O) GO TO 7 


206220 

DO 304 N=l, LINLOD 


206230 

RE AD! 5, 305 ) JEXT1 ,XFL , OUM 



305 FORMAT (5X*I5,E14.7,T1*20A4) 



WR I TE ( 6,2001 ) DUM 


206260 

304 CONTINUE 


206270 

7 RE AD! 5 , 2000 ) DUM 


206280 

WR ITE (6, 2001 ) OUM 


206290 

IF ID.NE.DLIMTR) GO TO 7 


206300 

WRITE (6,222) 


206310 

303 CONTINUE 


206320 

887 IF (NLDS.LE.ICT) GO TO 888 



CALL CYCLE 



ICT = ICT+1 



GO TO 887 



888 IF ( ICOUNT .EQ.O 1 GO TO 889 


206560 

WRITE (6,866 ) ICOUNT 


206570 

866 FORMAT(10l/)»l00X»I5»* ERRORS LOCATED.*) 


206580 

GO TO 1 


206590 

889 WRITE ( 6,865 ) 


206600 

865 FORMAT (10(/)«IOOX*'NO DETECTABLE ERRORS FOUND.*) 


206610 

GO TO 1 


206620 


24 







555 CALL EN DJOB 

STOP 

END 


206640 

206650 


25 



FOR. IS GRAPH, GRAPH 




SUBROUTINE GRAPH (NCHK.NRC) 

COMMON/GRAPHS/STIC ( 30)?STP{30)?Gl(30),G2(30J,G3(30), 

300010 

300020 



1IREGC, ISEG ,NSEG,MGEOM(30J , JL INK (30) ,ILINK(30) » ANGLNK ( 30 ) .NLINK, 

300030 



2JJTI30), IJTI30) 

300040 



COMMON/GPLOT /ZZ ( 600 )»RRAD(600)*NPT*NZR 

300050 



COMMON /SPLINS/ ANG, PS I ( 100 ) , RAOR ( 100 ) , Z 1(14 ) ,R I ( 14) ,NRZ IN, 

300060 



1 POL Y ( 10 ) , NCOEF 

300070 



COMMON NERROR 

300080 



DIMENSION PHI(20),RAD(20),Z(20) 




DIMENSION IDARY ( 2 ) 




DIMENSION R(3),ZE(9) 

300100 



DATA IOARY/ 1 HARDCO* , ' PY 




DATA AAA/ * A •/ 

300110 



DO 600 1=1,20 

300120 



RADI I ) = 0.0 

300130 


600 

zm = o.o 

300140 



IF ( ISEG .NE.DGO TO 20 

300150 



NPT=0 

300160 



RELOR =0.0 

300170 



IFUREGC .NE.DGO TO 20 

300180 



CALL IDENT (9, IDARY) 




IREGC = 2 

300200 


20 

IF (NCHK.EQ.l) GO TO 999 

300210 



MG = MGEOM(ISEG) 

300220 



GO TO (30, 30, 80, 70, 30, 30, 160, 999), MG 

300230 


30 

CONTINUE 

300240 



DELTA=(STP(ISEG)-STIC(ISEG) )/19.0 

300250 



DO 50 I = 1,19 

300260 



PH I ( I )= (I-1DDELTA + STIC(ISEG) 

300270 


50 

CONTINUE 

300280 



PHI ( 20 ) = STP(ISEG) 

300290 


60 

GO T0( 100,90,80,70, 130, 120, 160), MG 

300300 

c 



300310 

c 


CYLINDER 

300320 

c 



300330 


70 

CONTINUE 

300340 



NUMPT= 2 

300350 



RADII ) = G 1 ( ISEG) 

300360 



RADI 2 ) = RAO(i) 

300370 



Z(l) = STPIISEG)-STIC(ISEG) 

300380 



Z ( 2 )= 0.0 

300390 



GO TO 200 

300400 

c 



300410 

c 


CONE 

300420 

c 



300430 


80 

CONTINUE 

300440 



PHIANG* GUI SEG) 

300450 



COSP= COS (PH I ANG) 

300460 



RAO( 1 )= ST IC ( IS EG )* COSP 

300470 



RAO( 2 )= STP(ISEG)* COSP 

300480 



Z( 1)= SIN (PHI ANG )*( STP ( I SEG )-STIC ( I SEG ) ) 

300490 



Z ( 2 ) = 0.0 

300500 



NUMPT = 2 

300510 



GO TO 200 

300520 

c 



300530 

c 


OGIVE 

300540 

c 



300550 


90 

CONTINUE 

300560 
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C0SP= COS I STPI IS EG ) ) 


300570 



DO 95 1=1,20 


300580 



RAO( I )= (Gil ISEGXSINIPHIII ))) - G2IISEG) 


300590 



Z(I) = Gl ( ISEG)* ( COS ( PHI ( I J J-COSP ) 


300600 


95 

CONTINUE 


300610 



Z(20)= 0.0 


300620 



NUMPT =20 


300630 



GO TO 200 


300640 

c 




300650 

c 


ELIPSE-CG3 IS OFFSET DISTANCE) 


300660 

c 




300670 


100 

CONTINUE 


300680 



BB= G2IISEG) 


300690 



C= G3( ISEG) 


300700 



A= G 1 ( ISEG) 


300710 



B= G2I1SEG)* A 


300720 



00 109 1=1,20 


300730 



COSP= COS I PH I ( I ) ) 


300740 



S I NP= S1NIPHIII)) 


300750 



RAD(I) = SINP*A/((SINP**2+8B**2*C0SP**2)**.5)-C 


300760 



Z(I) = B*SQRT< 1.0-1 RADI I ) *C ) **2/A**2 > 


300770 



IF IPHIIII. GT. 1.5708. AND. PHIID.LT. 4. 61239) ZII) = -Z(I) 


300780 


109 

CONTINUE 


300790 



DO 107 1=1,20 


300800 


107 

Z(I) = Z ( I )-Z< 20 ) 


300810 



NUMPT = 20 


300820 



GO TO 200 


300830 

c 




300840 

c 


GENERAL GEOMETRY 


300850 

c 




300860 


120 

CONTINUE 


300870 



CALL GEOMET 


300880 



DO 450 K=1 , 20 


300890 



ARG * PHI(K) 


300900 



DO 404 J=l,100 


300910 



PHO = PSI(J) 


300920 



IF (ANG.EQ.AAAJ IF (ARG-PHO) 421,423,404 


300930 



IF 1 PHO- ARG ) 421,423,404 


300940 


421 

IF IJ-l) 8502,8502,424 


300950 


404 

CONTINUE 


300960 



GO TO 8503 


300970 


423 

RADIK) = RAORIJ) 


300980 



GO TO 450 


300990 

8502 

NERROR = 56 


301000 



CALL ETRAP 


301010 



WR ITE (6,989) NRC.ISEG 


301020 


989 

FORMAT I /5X, * * REGION NUMBER • , 1 2 , 5X , • SEGMENT NUMBER '.IZ, 1 

* .. 

301030 



L ///). 


301040 



NCHK = 1 


301050 



GO TO 999 


301060 

8503 

NERROR = 57 


301070 



CALL ETRAP 





WR ITE ( 6* 989 ) NRC.ISEG 


301090 



NCHK = l 


301100 



GO TO 999 


301110 


424 

SUBl. = ARG-PSIIJ-1) 


301120 



SUB2 = PSHJJ-PSKJ-l) 


301130 



RADIK) = R ADR! J-l ) ♦( RADR IJ)-RADR(J-l) ) 4 SUBl /SUB 2 


301140 


450 

CONTINUE 


301150 



RMAX = Rill) 


301160 



RMIN = RI(l) 


301170 
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DO 365 K=2»NRZIN 




301180 


IF (RIIK).LT.RMIN) 

RMIN = RIIKI 



301190 


IF (RI(K).GT .RMAX ) 

RMAX = RI(K) 



301200 

365 

CONTINUE 




301210 


DO 401 J=l, 20 




301220 


IF (RADI J ) .LT .RM IN ) 

RADI J ) « RMIN 



301230 


IF (RADI J ) .GT.RMAX I 

RADI J ) = RMAX 



301240 

401 

CONTINUE 




301250 


PI = 3.1415926/2.0 




301260 


P3 = 3.0*Pl 




301270 


DO 449 J=l,20 




301280 


PHO = PHIIJI 




301290 


IF (PHO.LT.P1.OR.PHO.GT.P3) GO TO 

353 


301300 


AA = RI(l) 




301310 


III =1 




301320 


C =» AA 




301330 


I = III 




301340 


JJ = 1 




301350 


DO 451 K=2, NRZIN 




301360 


IF (ANG.EO.AAA) IF 

(RADI JI-RIIK)) 

350,360,452 


301370 


IF (RI(K)-RAD(J) ) 350.360,452 



301380 


C » RIIKI 






I = K 




301400 


JJ * I 




301410 

451 

CONTINUE 




301420 

452 

0 = RIIKI 




301430 


II * K 




301440 


JJJ = II 




301450 


IF (I.NE.l) GO TO 460 



301460 


AA = RIIK+1) 




301470 


III = K+l 




301480 


R( 1 ) * C 




301490 


R(2) = D 




301500 


R( 3) = AA 




301510 


ZE (4 ) = Z I ( I ) 




301520 


ZE ( 5 ) = ZIIII) 




301530 


ZE (6 ) = Z I ( 1 1 1 ) 




301540 


GO TO 480 




301550 

460 

CONTINUE 




301560 


AA = RI(K-2) 




301570 


III = K-2 




301580 


R( 1) = AA 




301590 


R(2 1 = C 




301600 


R ( 3 ) = D 




301610 


ZE ( 4 ) * ZIIIII) 




301620 


ZE ( 5 ) = ZIII) 




301630 


ZE (6 ) * ZI(II) 




301640 


GO TO 480 



- 

301650 

353 

AA = RKNRZIN) 




301660 


III = NRZIN 




301670 


C « A 




301680 


I a III 






JJ = NRZIN 




301700 


L = NRZIN-1 




301710 


K - L 




301720 


DO 453 M=1,L 




301730 


IF ( ANG.EQ. AAA) IF 

(RADI J)-RI(K) ) 

349,360,454 


301740 


IF (RI(K)-RAD(J)) 349,360,454 



301750 

349 

C = RI(K) 




301760 


I = K 




301770 


JJ = I 




301780 
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|o o| 


K — 

453 CONTINUE — 

454 D = RIIK) 

II = K 

JJJ = II 

IF (I.NE.NRZIN) GO TO 470 

AA = RKK-II 

III = K-l 

R ( 1 > = C 

RI2) = D 
R ( 3 ) = AA 
ZEI4) » ZIU) 

ZE (5 ) = ZI(II) 

ZE<6) * ZIIIII) 

GO TO 480 

470 CONTINUE 

AA = RIIK+2) 

III * K+2 

R(l) = AA 

RI2) = C 

R ( 3 ) * D 

ZE<4» = ZKIII) 

ZEI5) = ZIII) . 

ZE (6 ) = ZI(II) 

480 CONTINUE 

ZE ( I ) = ZE(4)*ZE(4) 

ZE ( 2 ) = ZE ( 5 I *ZE ( 5 1 

•ZE ( 3 J * ZE ( 6 ) *Z E ( 6 ) 

ZE (7 ) = 1.0 
ZE ( 8 ) = 1.0 

ZEI9) = 1.0 

IF (PH0.GE.Pl.AND.PH0.LE.P3I GO TO 370 

ITHP = JJ ■ 

JJ = JJJ 
JJJ = ITHP 
370 CONTINUE 

CALL SIMQ (ZE,R> 

AA = R(l) 

BB f R( 2 ) 

CC = R ( 3 ) 

DISC = BB*BB-4.0*AA*(CC-RAD( J) > 

IF (OISC.LT.O.O » GO TO 8777 
Z1 » (-8B+SQRT t DISC ) >/( 2.0*AA ) 

Z2 = (-BB-SQRT(0ISC))/(2.0*AA > 

IF (Z1.GE.ZHJJI.AND.Z1.LE.ZK JJJ) ) Z(J) ; Z1 

IF (Z2.GE.ZI(JJ ).AND.Z2.LE.ZI(JJJ) ) Z(J) = 12 
GO TO 449 

8777 NRITEI6, 87781 J 

8778 FORMAT (//• FOR J “'tlS,* THE ROOTS ARE IMAGINARY') 
GO TO 449 

360 Z I J » = ZI(K) 

449 CONTINUE 
NUMPT = 20 
GO TO 200 


MODIFIED EL IPSE 


130 CONTINUE 

A » G21 ISEG) 

DO 110 1=1,20 
COSP = C0S1 PHI( I ) ) 


301790 

301800 

301810 

301820 

301830 

301840 

301850 

301860 

301870 

301880 

301890 

301900 

301910 

301920 

301930 

301940 

301950 

301960 

301970 

301980 

301990 

302000 

3020 10 

302020 

302030 

302040 

302050 

302060 

302070 

302080 

302090' 

302100 

302110 

302120 

302130 

302140 

302150 

302160 

302170 

302180 

302190 

302200 

302210 

302220 

302230 

302240 

302250 

302260 

302270 

302280 

302290 

302300 

302310 

302320 

302330 

302340 

302350 

302360 

302370 

302380 

302390 


29 







SINP = SINIPHII I)) 

302400 



SINP1 * 1.0/ISINP+-1.0) 

302410 



RADII) = 2 .0*A*SINP*SINP 1 

302420 


110 

Z(I) = 2.0*A*COSP*I2.0-SINP1)/13.0*ISINP*1.0)) 

302430 



00 111 1=1,20 

302440 


111 

Z(I) = ZIII-ZI20) 

302450 



NUMPT = 20 

302460 



GO TO 200 

302470 

c 



302480 

c 


DUMMY GEOMETRY 

302490 

c 



302500 


160 

CONTINUE 

302510 


200 

CONTINUE 

302520 



IF ( ISEG .NE.1IG0 TO 220 

302530 



IFUJT(l) .GT. I JT ( 1 ) > GO TO 230 

302540 



GO TO 250 

302550 


220 

CALL KLINKIIRETt LNKNUM ) 

302560 



GO TO 1230, 250, 230, 250), IRET 

302570 

c 



302580 

c 


CONNECTED AT ITH-JOINT 

302590 

c 



302600 


230 

CONTINUE 

302610 



Z1 = Z(1I 

302620 



DO 240 1=1, NUMPT 

302630 



zm = zm - zi 

302640 


240 

CONTINUE 

302650 



GO TO 270 

302660 

c 



302670 

c 


CONNECTED AT J-JOINT 

302680 

c 



302690 


250 

INDX= NUMPT/2 

302700 



00 260 1 = 1,1 NDX 

302710 



K= NUMPT+l-I 

302720 



TEMPZ= zm 

302730 



TEMPR= RADII I 

302740 



Z(I>= Z I K I 

302750 



RADI I )=RA01K> 

302760 



Z I K I = TEMPZ 

302770 



RADIK)= TEMPR 

302780 


260 

CONTINUE 

302790 

c 



302800 

c 


ADD LAST RELATIVE ORIGIN 

302810- 

c 



302820 


270 

DO 280 I=1*NUMPT 

302830 



ZII) = ZIII+RELOR 

302840 


280 

CONTINUE 

302850 



RELOR = ZINUMPT) 

302860 



IF 1 ISEG .EQ.1IG0 TO 300 

302870 



GO TO 1300.300.290,290), IRET 

302880 

c 



302890 

c 


KINEMATIC LINK AT THIS JOINT-ADJUST Z-COORDINATE 

302900 

c 





290 

DZ=IRADl D-RADOLD)* COTANl ANGLNK I LNKNUM )) 

302920 



DO 295 1=1 .NUMPT 

302930 



zm= zm ♦ dz 

302940 


295 

CONTINUE 

302950 



D = COTANl ANGLNK 1 LNKNUM 1) 

302960 


300 

RADOLD=RAO I NUMPT ) 

302970 



RELOR = ZINUMPT) 

302980 



DO 310 1=1, NUMPT 

302990 



RR AD I I+NPT ) = RAOII) 

303000 


30 





ZZ< I*NPT) = Z 1 I ) 

303010 

310 

CONTINUE 

303020 


NPT=NPT +NUMPT 

303030 

999 

RETURN 

303040 


ENO 

303050 
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FOR, IS KLINK,KLINK 

SUBROUTINE KLINK! IRET.LNKNUM) " ' 400010 

CQHMON/GRAPHS/ST IC( 30 ) , STP ( 30 ) , G I ( 30 ) ,G2 ( 30 ) ,G3 ( 30 ) , 400020 


1IREGC, ISEG » NSEG, MGEOM ( 30 ) , JL INK ( 30 ) , IL INK ( 30 ) , ANGLN K ( 30 ) ,NL INK , 400030 

2JJT!30)»IJT!30) 400040 

ISEGC = ISEG 400050 

IF ! I JT ! ISEGCI.EQ. I JT (I SEGC-1 > . OR . I JT! ISEGC ) .E Q.JJTt ISEGC-1> ) 400060 

1G0 TO 10 400070 

IFIJJT! ISEGC). NE. I JT ( I SEGC- 1 ) . AND. J JT I I SEGC ). NE . JJ T (I SEGC-1 ) ) 400080 


1G0 TO 30 400090 

C CONNECTEO AT j-JOINT 400100 


IRET= 2 400110 

GO TO 100 400120 


CONNECTEO AT I-TH JOINT 400130 

10 IRET= 1 400140 


GO TO 100 400150 

C' 400160 


IS THERE A KINEMATIC LINK 400170 

400180 


30 DO 50 1= 1 , NL INK ~ 400190 

IFIIJTI ISEGCI.EQ. JLINKIIDGO TO 40 400200 


IFIJJT! ISEGC). NE. JLINK(I))GO TO 50 400210 

IRET= 4 400220 

GO TO 45 " 400230 

40 IRET=3 400240 


45 LNKNUM= I ‘ 400250 

GO TO 100 400260 


50 CONTINUE 
WRITE! 6,60 ) 

60 FORMAT!/, IX, • ***-ERROR-UNCONNECTED JOINT BETWEEN SEGMENTS* ) 

STOP 

100 RETURN 
ENO 


400270 

400280 

4OO290 

400300 

400310 

400320 
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FOR, IS ZPLOT.ZPLOT 

SUBROUTINE ZPLOT (JCLUE) 

COHMQN/GRAPHS/ST IC! 3Q),STP( 3Q),G1(30),G2130) ,G3(30), 

1IREGC, ISEG ,NSEG,MGEOMI30),JLINKI30),ILINKI30>,ANGLNK!30> ,NLINK, 

2JJT!3Q>,IJT130) 

COMMON /GPLOT/ ZZ ( 600 ) , RRAD ( 600 ) ,NPT,NZR ,DX 

DIMENSION YTITLEI 12 ) , XT ITLE 1 1 2 ) 

01 MENS ION TITLE! 12) 

DIMENSION ALPHA! 3) 

EXTERNAL TABL1V 

DATA VTITLE/'Z - »X‘,' IS • , 10*6H t 

DATA XTITLE/'RAOIUS't • OF RE* , 'VOLUTI • • 'ON " • ,8*6H ' / 

DATA TITLE/* R',«EG I ON ', 'NUMBER',' _S' % • _l±_ 

1 '• ',' SEGME 1 , 'NTS ',' ',* " ',' LINKS'/ 

CALL CHS IZV ! 2, 2 ) 

CALL RITSTV ( 13 , 19, TABL IV ) 

C 

DS = DX 

IF I JCLUE . EQ . 1 ) G O TO 200 _ 

YHIN = ZZ!1» 

YMAX = ZZI1) 

XMJN = 0.0 

XMAX = RRA0I1) _ 

DO 400 J = 2 « NPT 

IF IZZ(J).LE.YMIN) YMIN ■ ZZIJ) 

IF ( ZZ ( JJ.GT.YMAX) YMAX * ZZIJ) 

IF IRRAOtJI.GT.XHAX) XMAX = RRAD! J > 

400 CONTINUE 

IF I DX.NE.O.O) GO TO 500 _ 

DX = XMAX-XMIN 

DV = YHAX-YM IN 

IF (DV.LT.OX) DV = DX 

GO TO 600 

500 DV = DX 

600 CONTINUE 

YOIF = I YMAX— YMIN ) / 2 .O+YM IN 

YHIN = YDIF-0V/2.0 * . _ 

YMAX = YCIF+DV/2.0 

XO IF = ! XMAX— XM IN )/2.0-*-XHIN 

XMIN = X0IF-DV/2.0 

XMAX = XDIF*0V/2.0 _ _ 

CALL SCRND ! XMAX, XMIN, XMX, XMN ) 

CALL SCRND 1 YMAX , YM IN, YMX , YMN ) . 

CALL QUIK3L !-l , XMN, XMX , YMN, YMX, IHX,XTITLE, YTITLE,-NPT , RRAD, ZZ ) 

200 IF ! JCLUE. EQ.l) CALL FRAMEV 12) 

ENCODE !80I, ALPHA) NZR, NSEG.NL INK 

801 FORMAT! 3 16) 

TITLEI4) = ALPHA! 1) 

TITLE!7) = ALPHA! 2 ) 

TITLE! 11 J = ALPHA ( 3 ) 

CALL RITE2V 1 46, 1005, 1023, 90, 1 , 72 , 1 , TITLE , IERR ) 

IF ! JCLUE. EQ.OJ GO TO 99 

CALL CHS IZV 19,9) 

CALL RITSTV ! 48 , 68, TABL IV ) 

I * 100 

J = 900 

CALL RITE2V !I , J , 1023, 90 , 1 , 6, 1 , 6HDUE TO, IERR) 

J » J-100 

CALL RITE2V (I, J, 1023,90,1, 5, 1,5HINPUT, IERR) 

J = J-100 

CALL RITE2V 1 1 , J , 1023 ,90 , 1, 5, 1 , 5HERR0R , I ERR ) 
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IF (JCLUE.EQ.l) GO TO 100 

J = J-100 

CALL RITE2V ( I , J , 10 23, 90 , 1 , 11 , 1, 1 1HTHE REST OF > IERR) 
100 J = J-100 

CALL R1TE2V ( I , J, 1023,90, 1 , 11 , l t 1 1HTHIS R EGION , I ERR) 
J = J-100 

CALL RITE2V ( I , J , 1023 ,90 , 1 , 6, 1 , 6HI S NOT, IERR) 

J = J-100 

CALL RITE2V ( I t J . 1023 , 90 t 1 , 9 , 1 ,9HGR APHABLE , IERR ) 

99 CONTINUE 

OX = OS _ _ 

RETURN 

END 
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FOR. IS GEOMET.GEflMET 


C 

C 

C 

C 

C 

C 

C 

C 

C 


SUBROUTINE GEOMET 

THIS SUBROUTINE CALCULATES THE GEOMETRY FOR A SHELL SEGMENT. 


600010 

6Q0020 


THE INPUT VARIABLES ARE . . . 

RHP DISTANCE FROM AXIS OF REV. TO POINTS 


600030 

600040 


zim 


ON SHELL MERIDIAN. 

- DISTANCE ALONG AXIS OF REV. TO THE 


600050 

600060 


INTERSECTION OF THE CORRESPONDING RIII) AND 
THE AXIS OF REV. 


600070 

600080 


NR2IN NUMBER OF (RI.ZII PAIRS READ AS INPUT. 


COMMON /SPLINS/ ANG, PS I < 100 ) , R ADR <100 > , ZI ( 14 ) ,R I (14) , NRZ I N, 
1 POLVt 10 > .NCOEF 


C 

c 


DIMENSION Cl <4. 13 ) . ORDZ ( 141 ♦ SOUTI 14),S( 101) ,RADD< 100) 


600090 

600100 


600110 

600120 


600130 

600140 


FUN(ARG) » SORT (1.0 ♦ ARG**2) 


600150 

600160 


RADS = 3.1415926/180.0 
DATA B/'B •/ 


AMULT * 1.0 

IF (ANG.EQ.B) AMULT * -1.0 


600170 

600180 


600190 

600200 


PASS SPLINE CURVE THROUG H INPUT POINTS ON SHELL MERIDIAN. AND 
COMPUTE OR/OZ AT THESE POINTS. 


600210 

600220 


600230 

600240 


CALL PLICO (ZI.RI.NRZIN.CI) 
NDELZ = NRZ I N - 1 


600250 

600260 


DO 60 IM.NRZIN 

CALL PLINE (ZIiRI.NRZINtCI.ZI ( I ) , FAKE1 , DRDZ ( I ) « FAKE2 ) 
60 CONTINUE 


C 

C 

C 

C 

C 

C 


COMPUTE MERIDIONAL ARC LENGTH TO INTERPOLATED POINTS BY 
NUMERICAL INTEGRATION (SIMPSONS RULE). SINCE SIMPSONS RULE 


600270 

6002B0 


600290 

600300 


600310 

600320 


REQUIRES AN EVEN NUMBER OF PARTITIONS, INTERPOLATE A POINT 
MIOWAY BETWEEN EACH PAIR OF POINTS USING SUBROUTINE SPLINE. 


SOUTH ) = 0. 


00 70 1=1, NDELZ 
DZ2=(Zimi)-ZI(I))/2.0 


600330 

600340 


600350 

600360 


600370 

600380 


DZ6=DZ2/3.0 

CALL PLINE (ZI.RI.NRZIN.CI. ZI( t )+DZ2,FAKEl,0R0ZM,F AKE2 1 


SOUT(I + U = SOUT(I) ♦ 0Z6* ( FUN (DRDZ( I) ) ♦ 4 • 0*FUN I DR DZM) 
1 FUN( OROZ ( I H ) ) ) 


70 CONTINUE 


C 

C 

C 

C 


600390 

600400 


600410 

600420 


600430 

600440 


USE SPLICO TO REPRESENT RIII) AS A FUNCTION OF SOUTI I ) . THEN USE 
SPLINE TO INTERPOLATE RADD. 


600450 

600460 


0LDH1 = SOUT (NRZINI/99.0 
100 CALL PLICO (SOUT.RI.NRZIN.Clf 
DO 110 1 = 1,100 


600470 

600480 


600490 

600500 

600510 


Sill = FLOAT ( 1-1 )*0LDH1 


no 

IF ( ABS ( RADD( III.GT.1.0) RADD(I)=1.0 
CONTINUE 

600530 

600540 


00 180 J=l,100 
COSPSI = AMULT*RADD( J) 

600550 

600560 


PSIIJI = ARCOSI COSPSI ) 

600570 


IF (ANG.EQ.B) GO TO 180 

600580 


PSIU) = 2.0*3. 1415926-P SI ( J ) 

600590 

180 

CONTINUE 

600600 
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non non ooo 



XC22 * ST(ll.LL) 

703070 


XC 15 = ST ( 12 >L'L I 

703080 


XC 16 = ST ( 13 tLL ) 

703090 


XMERD = ST«NC0NT-2,LU 

703100 


XPRES = ST I NC0NT-l*LL ) 

703110 


XMONT = ST (NCONT »LL ) 

703120 


XK21 = XK 12 

703130 


XD21 = X012 

703140 


GO TO 103 

703150 

703160 

40 

CONTINUE 

703170 


IF (IMORD.EQ.l) GO TO 140 

703180 


RHOR » 0.0 

703190 


RHOS = 0.0 

703200 


RHOI =» 0.0 

703210 


RHOC = *0.0 

703220 


XMERD = 0.0 

703230 


XPRES = 0.0 

703240 


XMONT =0.0 

703250 

140 

CONTINUE 

703260 


TEMP3= Il.O-XNUPT * XNUTPI 

703270 


GO TO (42, 47, 49,41), THICK 

703280 

41 

GO TO (103,42, 103, 42,47. 49,42,47, 49, 42, 47,49 ) , I STTAB 

703290 

703300 


SINGLE SHEET 

703310 

703320 

42 

TEMPI = ETHET*HI 

703330 


TEMP2= TEMPI * HI**2 

703340 


XK 1 1= TEHP1/TEMP3 

703350 


X011= TEMP2/I12.0* TEMP3 ) 

703360 


TEMPI = EPHI *HI 

703370 


TEMP2= TEMP1*HI**2 

703380 


XK22= TEMP1/TEMP3 

703390 


XD22= TEMP2/I12.0* TEMP3 ) 

703400 


XK33 = XGPT*HI 

703410 


X033= XK33*H I** 2/12.0 

703420 


YBARI = 0.0 

703430 


YBARC = 0.0 

703440 


YBARO = 0.0 

703450 


GO TO 55 

703460 

703470 


EQUAL SHEETS 

703480 

703490 

47 

CONTINUE 

703500 


XK11 = 2 .0*ETHET*HI /TEMP3 

703510 


XK22 = 2.0*EPHI*HI/TEMP3 

703520 


XK33 = 2.0*XGPT 

70^530 


ZBR = HI-*T/2.0 

703540 


ZBH = ( ZBR-H 1/2 .0 )**2 

703550 


XD33 = XGPT*HI*((HI**2)/6.0*2.0*ZBH) 

703560 


X011 = HI*(XKll*HI/12.0+2.0*ETHET*ZBH/TEMP3> 

703570 


XD22 = HI*(XK22*HI/12.0*2.0*EPHI*ZBH/TEMP3> 

703580 


YBARI = ZBR-HI/2.0 

703590 


YBARC = ZBR-HI-T/2.0 

703600 


YBARO = HI/2.0-ZBR 

703610 


GO TO 55 

703620 

703630 


UNEQUAL FACE SHEETS 

703640 

703650 

49 

CONTINUE 

703660 


ZBR » (HI*HI+HO*H0+2.0*( HO*(HI*T> >> / < 2. 0* (HI *H0 ) > 

703670 


36 



FOR, IS PLINE,PLINS 


c 


SUBROUTINE PUNE ( X , Y ,M , C, X INT , Y INT , DYDX , D2YDX2 ) 

SUBROUTINE FOR SPLINE FIT INTERPOLATION IN THE TABLE OF VALUES 

700010 

700020 

c 


(XI, Yl) TO ( XM, YM 1 , WHERE M HAY BE AS LARGE AS 100, WHERE THE 

700030 

c 


CONSTANTS C( 1 ,K ) ,C( 2,K ) , C( 3,K ) AND C(4,K) ARE ALREADY COMPUTED 

700040 

c 


AND STORED. 

700050 

c 


SUBROUTINE ALSO COMPUTES DY/DX AND D2Y/DX2 AT XINT. 

700060 



DIMENSION X(14),Y(14),C(4,13) 

700070 



IF (XINT-X(l)) 80,10,20 

700080 


1C 

YINT = Y(l) 

700090 



K=1 

700100 



GO TO 70 

700110 


20 

K = 1 

700120 


30 

IF ( XINT-X( K*1 ) ) 60,40,50 

700130 


40 

YINT = Y (K-t-1 ) 

700140 



GO TO 70 

700150 


50 

K = K + 1 

700160 



IF (M-K) 80,80,30 

700170 


60 

YINT = ( X( K+l ) - XINT)*(C(1,K)*(XIK+1)-XINT)**2«C(3,K) ) 

700180 



YINT = YINT + (XINT-X(K) ) * (C ( 2 ,K ) *( XINT-X (K> )**2+C (4 ,K ) ) 

700190 


70 

DY0X=-3.0*(C(1,K)*(X(K+1)-XINT)**2-CI2,K)*(XINT-X(K) >**2> 

700200 



l -C( 3, K ) +C< 4,K ) 

700210 



02YDX2=6.0*(C(1«K)*(X(K*-1)-XINT)+C(2,K)* ( XINT-X IK ) ) ) 

700220 



RETURN 

700230 


80 

WRITE (6,90) 

700240 


90 

FORMAT { 3 1H OUT OF RANGE FOR INTERPOLATION) 

700250 



RETURN 

700260 



ENO 

700270 
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FOR, 

IS PL ICO, PL l CO 


C 

SUBROUTINE PLICO (X,Y,M,C) 

SUBROUTINE TO DETERMINE C ( 1 ,K ) ,C ( 2,K ) ,C ( 3,K > AND C(4,K). 

800010 

800020 


DIMENSION XC 14) ,Y<14) ,AI 14,3) ,B( 141,21 14) 

800030 


DIMENSION D( 13),P(13),E( 13 ) ,C ( 4, 13) 

800040 


MM = M-l 

800050 


DO 10 K=1,MM 

800060 


D( K) = XIK4-1 ) - X (K ) 

800070 


P(K) = DIKI/6.0 

800080 

10 

E ( K ) * (Y(K+1>-Y(K) )/0(K J 

800090 


DO 20 K=2,MM 

800100 

20 

B( K) = ECK) - E(K-1» 

800110 


A( 1,2) = -1.0-0(11/0(2) 

800120 


A(l, 3) = D( 1 )/0( 2 ) 

A( 2,3 ) = P(2)-P(1)*A( 1,3) 

800130 

800140 


A( 2, 2 ) = 2.0*(P(1)+P<2>) - P(1)*A(1,2) 

800150 


A ( 2,3 ) ■ A(2,3)/A(2,2) 

800160 


B( 2 ) = B ( 2 ) / A ( 2, 2 ) 

800170 


DO 30 K=3 , MM 

800180 


AIK, 2) = 2.0*(P(K-1)*P(K))-P(K-1)*AIK-1,3) 

800190 


B( K) * B(K)-P(K-1)*B(K-1) 

800200 


A( K, 3 ) = P t K )/A ( K , 2 ) 

800210 

30 

B ( K) = B ( K ) / A( K , 2 ) 

800220 


Q = D(H-2)/D(M-l) 

800230 


A( M, 1 ) = 1 .O+Q+A ( M— 2, 3 ) 

800240 


AIM, 2) = -Q-A( M, 1 )*A ( M-l , 3 ) 
B ( M) a B ( M-2 )-A( M,1 )*B( M-U 

800250 

800260 


Z(M) =* B(M)/A(M,2) 

800270 


MN = M-2 

800280 


DO 40 1=1, MN 

800290 


K = M— I 

800300 

40 

Z(K) = B(K)-A(K,3)*Z(K-»1) 

Z(l) = -A(1,2)*Z(2)-A(1,3)*Z(3) 

800310 

800320 


DO 50 K= 1 , MM 

800330 


Q = 1.0/(6.0*0(K) ) 

800340 


C ( 1 , K ) = Z ( K )*Q 

800350 


C ( 2 ,K ) = Z ( K *1 ) *Q 

800360 

50 

C ( 3,K) =Y(K)/D(K)-Z(K)*P(K) 

C ( 4, K ) = Y(K+1)/D(K)-Z(K*1)*P<K) 

800370 

800380 


RETURN 

800390 


END 

800400 
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FOR, IS SIHQ,SIMQ 




SUBROUTINE SIMQ ( A, B ) 
DIMENSION A( 1 ) , B( 1 ) 

900010 

900020 

c 



900030 

c 


FORWARD SOLUTION 

900040 

• c 



900050 



N = 3 

900060 



TOL = 0.0 

900070 



KS = 0 

900080 



Jj = -N 

900090 



DO 65 J=1,N 

900100 



JY = J + l 

900110 



JJ = JJ+-N+1 

900120 



BIGA = 0.0 

900130 



IT = JJ-J 

900140 



DO 30 I=J,N 

900150 

c 



900160 

c 


SEARCH FOR MAXIMUM COEFFICIENT IN COLUMN 

900170 

c 



900180 



IJ = IT+I 

900190 



IF (ABS(BIGA)-ABS(A( IJ) ) ) 20,30,30 

900200 


20 

BIGA = A ( I J ) 

900210 



IMAX =» I 

900220 


30 

CONTINUE 

900230 

c 



900240 

c 


TEST FOR PIVOT LESS THAN TOLERANCE I SINGULAR MATRIX! 

900250 

c 



900260 



IF (ABSIBIGA J-TOL) 35,35,40 

900270 


35 

KS = 1 

900280 



RETURN 

900290 

c 



900300 

c 


INTERCHANGE ROWS IF NECESSARY 

900310 

c 



900320 


40 

II = J+N*( J-2 I 

900330 



IT = IMAX-J 

900340 



DO 50 K=J,N 

900350 



II = Il+N 

900360 



12 = 1 1+ IT 

900370 



SAVE = A(H) 

900380 



A ( 1 1 ) = AII2I 

900390 



A< 12 » = SAVE 

900400 

c 



900410 

c 


DIVIDE EQUATION BY LEADING COEFFICIENT 

900420 

c 



900430 


50 

A ( I 1 ) = A< I I J/BIGA 

900440 



SAVE = B { I MAX I 

900450 



B(IMAX) = B ( J > 

900460 



BIJ) = SAVE/BIGA 

900470 

c 



900480 

c 


ELIMINATE NEXT VARIABLE 

900490 

c 



900500 



IF (J-N) 55,70,55 



55 

IQS * N*( J-I ) 

900520 



DO 65 I X=JY , N 

900530 



IXJ = IQS+IX 

900540 



IT = J-IX 

900550 



DO 60 JX= JY , N 

900560 



IXJX = N*( JX-1 ) + I X 

900570 



JJX = IXJX+IT 

900580 


60 

A ( IXJX ) = A< IXJXI-I A( IXJ)*A(JJX»> 

900590 


65 

8( IX ) « B(IX)-I8IJ)*A(IXJ) > 

900600 


39 



c 



900610 

c 


BACK SOLUTION 

900620 

c 



900630 


70 

NY = N— 1 

900640 



IT * N*N 

900650 



DO 80 J=1»NY 

900660 



IA = IT-J 

900670 



IB = N-J 

900680 



IC = N 

900690 



DO 80 K= 1» J 

900700 



B( IB ) = B( IB )-A ( I A l*B ( IC ) 

900710 



I A = IA-N 

900720 


80 

IC = IC-1 

900730 



RETURN 

900740 



END 

900750 
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FOR, IS CYCLE, CYCLE 

SUBROUTINE CYCLE 

INTEGER S'EGTAB.TYPE 

COMMON NERROR.ICOUNT 

COMMON /TYGER/ XMAT (270. 10) ,LST( 30 > ,ST ! 30. 31 ) ,OUH( 20 ) . NS EGS! 30) , 

C NRNG(30), JROW! 30, 30), KELVN! 30,30), JMAT! 30,30) , 

0 NPP I 30, 30 ) ,NXMAT 120) ,NREG, NORING, NMPT 

COMMON /NAM1/ FACE ( 4 ) , STRGOI 7 ) , THERM! A > .MATER ( 3 ) .SEGTABt 12 ) 

EQUIVALENCE (OUM(l).O) 

DATA DL IMTR/4H / 1 

READ! 5, 1010) LINPUT ,C YC1 .CYCP.L01 S TL ._NM AJ , OMEGA, OUM 

1010 FORMAT ( 7X, 12 ,2X , F6.0, F4 .0, 2X, 2 12, 31X^E14.7« T 1, 20A4 ) 

WRITE 1 6 , 2001 ) DUH 

2001 FORMAT! IX, 20A4) 

IF ( LOI STL.EQ.O ) LDISTL = 1 

IF (NMAT.EQ.O) GO TO 1 

NROW = 0 

KK = -1 

NSAVE * 0 _____ 

DO 13 1*1, NMPT 

KK * KK*2 

II = NROW+i 

/ REAP! 5, 1004) STO, TYPE, OUM 

1004 F0RMAT!2!A4,6X) ,Tl,20A4) 

WRITE! 6, 200 1 ) OUM 

NROW = 27 

DO 11 L=l,3 

11 IF I TYPE. EQ. MATER! L ) ) GO TO 12 
NERROR = 1 

CALL ETRAP 

WRITE! 6, 223) . 

223 FORMAT 1 28X , 103H* DUE TO INPUT ERROR IT IS IMPOSSIBLE TO CHECK TH 200830 

IE FOLLOWING CAROS UP TO THE DASH-SEPARATOR CARD. »/) 200840 

GO TO 2 

12 CONTINUE __ _ 

IF IL.EQ.l) NROW * 7 

IF (L.EQ.2) NROW * 17 

LLL = NSAVE+NROW 

READ! 5, 1005) 1 1 XMAT ! M , J ) , 1 , 10 ) , M= 1 1 , LLL ) 

1005 F0RMAT!5E14.7) 

WRITE !6, 1205) ! 1 XMAT ! M, J ) , J* 1 , 10 ) ,M = I 1 , LLL ) . 

1205 FORMAT! IX, 5E 14. 7) 

DO 608 M*3 ,10 , 

IF (XMAT III, M-l ).LT .XMAT! 1 1 ,M ) ) GO TO 608 

IF (XMAT! II,M).EQ.0.0) GO TO 608 

NERROR = 32 
CALL ETRAP 
608 CONTINUE 

NROW = NSAVE+NROW 

13 NSAVE * NROW 

2 RE AO! 5 ,2000 ) DUH 

2000 FORMAT! 20A4) 

WRITE (6,2001 ) DUM 
IF (D.NE.DLIMTR) GO TO 2 
WRITE (6,222) 

222 FORMAT!/) 

1 CONTINUE 

IF (LDISTL. EQ. I ) GO TO 150 

DO 100 JREG= l.NREG 

NSEG * NSEGS(JREG) 

DO 105 JSEG*1,NSEG 
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NROW » JROW1 JREG, JSEG ) 

KELVIN = KELVN! JREG, JSEG) 

MAT = JMAT! JREG, JSEG) 

NP => NPP< JREG, JSEG) 

K * NROW+1 

JJ = 1 

JJJ ° 6 ; 

JT = JJ 

JTT - JJJ 

L = 0 

READ! 5, 10141 I LST ( J ) , J = J J, J J J ) , OUM 

1014 FORMAT!6Il,Ti,20A4> 

WRITE16, 2001 ) OUH a 

IF (LST(JJ>) 8031,19,20 

20 L = LST ( JJ ) 

1026 IF ILSTID.NE.l. AND. (KELVIN. EQ. 3. OR. KELVIN. EQ.4>) GO TO 1027 
GO TO 1028 

1027 NERROR = 35 

CALL ETRAP 

HR ITE(6»999 ) NRC.NSC 

999 FORMAT ( /5X, • * REGION NUMBER • ,1 2, 5X, • SEGMENT NUMBER *,12,' *• 

1 /// ) 

1028 IF !LST!1).NE. 4. AND. KELVIN. EQ.l) GO TO 1029 
GO TO 1025 

1029 NERROR = 35 
CALL ETRAP 

WRITE (6,999 ) NRC,NSC 

1025 IF U.NE.l.AND.L.NE.4) GO TO 8031 

GO TO 19 

8031 NERROR = 27 

CALL ETRAP 

WRITE (6 , 999 ) NRC.NSC 
WR ITE ( 6, 223 ) 

GO TO 7 
19 JJ * JJ+1 

IF IL. NE.O. AND. KELVIN. EQ. 2) GO TO 8075 

GO TO 23 

8075 NERROR = 35 

CALL ETRAP 

WRITE (6,999 ) NRC.NSC 

23 IF ILSTIJJ)) 8032,22,21 

21 L = L+l 

IF !LST! JJ).NE.l) GO TO 8032 

22 IF (JJ.EQ.JJJ) GO TO 24 

JJ = JJ»1 

GO TO 23 

8032 NERROR = 27 

CALL ETRAP 

WRITE 16, 999 ) NRC.NSC 

WRITE! 6, 223 ) ’ 

GO TO 7 

24 IF ( L.EO.O > GO TO 71 

LY » K ' 

KK * K*L-1 
00 72 M=K,KK 

READ! 5, 1005 ) ( ST ! M, J ) , J= 1 , NP ) 

WRITE(6, 1205) 1 ST ! M, J ) , J = 1, NP ) 

72 CONTINUE 

71 CONTINUE 

IF (NMAT.EQ.O.OR.LOISTL.NE.l) GO TO 590 

WRITE !6 , 996 ) 
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996 F0RMATI/35X, 'WARNING - CHECK PREVIOUS TEMPERATURE LOADS (IF ANY) A 
IGA INST NEW" MATERIAL PROPERTY TABLE RANGE.'/) 

GO TO 105 _ 

590 CONTINUE 

IF (LST(l).EQ.O) GO TO 105 

IF (MAT.GT.NMPT) GO TO 7 

IF ( NP.LT.2.0R.NP.GT.30 ) GO TO 7 

IF (KELVIN.NE. 5) GOTO 125 

IF (LST( D.EQ. l) KELVIN = 3_ 

IF (LST(l). EQ. 4) KELVIN ='l 
125 CONTINUE 

00 123 LL=1,NP 

1 = (MAT-1 )*2 + l _ _ 

" 1 1 =NXMAT ( L ) 

I 1 1 - NXMAT ( L + y . _ 

M= 1 " --- 

_G0 TO J91, 123,93, 93), KELVIN __ 

9 1 TEMPAV = (ST(lY,LL)4ST(LY*l,LL)+ST(LY+2,LL)+ST(LY*3,LL))/A.O 

ARG=TEMPAV 

GOTO 94 

93 ARG = ST ( NROW * 1,LL) _ _ 

94 DO 104 1=2,10 

_IF_ (ARG-XMATI II, I )) 121, 123,104 _ 

121 IF (1-2) 8007,8007,123 

8007 NERROR =28 

CALL ETRAP 

WR ITS( 6 , 998 > NRC,NSC,LL 

998 F0RMAT(/5X, r * REGION NUMBER ' , 1 2 , 5X, • SEGMENT NUMBER ', 12, 5X, 204760 

1 'SEGMENT GEOMETRY TABLE ITEM ',12,' *•///) 

GO to 123 

104^ CONTINUE 

NERROR = 29 

CALL ETRAP 

WR ITE ( 6, 998 ) NRC.NSC.LL 

123 CONTINUE _ 

105 CONTINUE 

NRING = NRNG(JREG) 

IF (NRING . EQ .0 ) GO TO 100 

00 110 K= l, N RIN G _ 

RE AO ( 5, 2 15 T S IGOX ,RMOSS, RMOSN, T I , TO , DUM 
215 FORMAT (5E14.7,T1,20A4) 

110 WRITE (6, 2001) DUM 
100 CONTINUE 

IF (NORING.EQ.O) GO TO 250 

DO 240 J = l, N ORING 

READ! 5,215 ) S IGOX , RMOSS , RMOSN » T I , TO , DUM 
240 WRITE! 6 , 2001 ) DUM 
250 CONTINUE 

RE ADI 5 , 302 ) LINLOD.OUM 
302 FORMAT! I4.Tl.20A4) 

W R ITE ( 6 , 20 01 ) DUM 

IF 1LINLCD.E0.0 ) GO TO 7 
DO 304 N= 1 , L INLOO 

READ! 5, 305) JEXT 1 , XFL »DUM 

305 FORMAT(5X,I5,E14.7,T1,20A4) 

WRITE (6, 2001) DUM 

304 CONTINUE 

7 RE ADI 5, 2000) DUM -- 

WRITE(6,2001 I DUM _ 

IF (D.NE.OLIMTR) GO TO 7 

WRITEJ6.222) 
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FOR, IS PLICO, PLICO 

SUBROUTINE PLICO IX,Y,M,C) 

C SUBROUTINE TO DETERMINE C11»KJ*C12«KJ,CI3»K) AND CU.K). 
DIMENSION XI 14), Yt 14), At 14, 3 ) , Bl 14 ) , Z 1 14 ) 

01 MENS ION Dtl3),P|13),Ell3),CI4,13) 

MM - M-l 

DO 10 K« 1 » MM 

OIK) <* XIK-H) - X I K ) 

PIK) > DIKI/6.0 
10 EIK) = lYlK4lJ-YtK) I/OIK) 

DO 20 K=2»MM 
20 BIK) = EIK) - EIK-1) 

All, 2) = -1.0-01 11/012) 

All, 3) = 0ID/0I2) 

A I 2, 3 ) = PI 2 I — P 1 1 1 * A I 1,3) 

A I 2,2 ) = 2.0*IPIU+P12)) - Pll)*All,2> 

A I 2, 3 ) a A(2,3)/AI2,2) 

B I 2 ) a BI2)/AI2,2) 

00 30 K=3,MM 

AIK, 2) = 2.0*IPIK-1)*PIK) )— PIK-1 )*AIK-l,3) 

BIK) = BIK )-PIK-l )*BI K-l ) 

AIK, 3) a P(K)/AIK,2) 

30 BIK) a BIK)/ AIK, 2) 

0 = OIM-2 ) /O IM-1 ) 

Al M, 1 ) = l.04Q4A|M-2,3) 

AIM, 2) = -Q-AIM,1)*AIM-1,3) 

BIM) = BIM-2 )-AIM, 1 )*BIH-1) 

ZIM) a B I M )/ Al Mj 2 ) 

MN a M-2 
00 AO 1=1, HN 
K = M-I 

40 Z( K ) = BIK)-AIK,3)*ZIK4l ) 

ZU> = -All, 2) *Z 12) -All, 3) *Z 13) 

DO 50 K= 1, MM 
Q = 1.0/ (6.0*01 K ) ) 

C I 1»K) = ZIK)*Q 

C 1 2, K ) = Z I K + l )*Q 

CI3.K) = YIK )/OIK)-ZIK)*PIK) 

50 CI4,K) = YIK4l)/0IK )— Z IK+l ) *P l K ) 

RETURN 

ENO 


2500010 
2500020 
2500030 
2500040 
2500050 
2500060 
2500070 
2500080 
2500090 
2500100 
2500110 
2500120 
2500130 
2500 140 
2500150 
2500160 
2500170 
2500180 
2500190 
2500200 
2500210 
250(122-0 
2500230 
2500240 
2500250 
2500260 
2500270 
2500280 
2500290 
2500300 
2500310 
2500320 
2500330 
2500340 
2500350 
2500360 
2500370 
2500380 
2500390 
2500400 
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FOR, IS ETRAP, ETRAP 

SUBROUTINE ETRAP 1000010 

COMMON NERRORfI COUNT 1000020 

ICCUNT = 1C0UNT+1 ' 1000030 

GO TO 11, 2, 3, A, 5, 6, 7, 8, <5, 10, 11, 12, 13, 14,15,16,17,18,19,20,21,22, 1000040 

1 23,24,25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, AO), NERROR 

1 WRITE (6, 101) 1000060 

101 FORMAT!/ 4X,*0NE OF THE MATERIAL PROPERTY TABLES CANNOT BE IDENTI 1000070 

IF I ED AS ISOT, ORTH, OR ST IF . • / » lOOOOBO 


2 

102 


GO TO 99 1000090 

WR ITE ( 6 , 102 ) 1000100 

FORMAT!/ AX , * T H E TYPE OF GEOMETRY OF A SEGMENT CANNOT BE IDENTIFI 1000110 
1JD ASJ3NE HANDLED BY THE PROGRAM.*/) 1000120 

GO TO 99 1000130 

WR I TE ! 6 , 103 ) 1000140 


103 


4 

104 


FORMAT ( / 4X , ’ T HE NUMBER OF POINTS IN THE ST TABLE MUST BE BETWEEN 1000150 
1 2 AND 30.*/) 1000160 

GO TO 99 1000170 

WR I TE ( 6 , 104 ) 1000180 

FORMAT ( / "AX', ‘A MATERIAL PROPERTY TABLE NAME FOR A SEGMENT CANNOT 1000190 
1BE FOUND IN THE TABLE LIST.*/) 1000200 


GO TO 99 

5 WR I TE { 6 , 10 5 ) 

105 FORMAT {/ 4X,*THE TYPE OF MATERIAL PROPERTY TABLE FOR A SEGMENT CA 
INNOT BE IDENTIFIED AS ISOT, ORTH, OR STIF.*/) 

GO' TO 99 

6 WR I TE ( 6 , 106 ) 


106 


7 

107 


FORMAT!/ 4X , 'THE PROBLEM INPUT CAN ONLY BE THIC, RWAF, RWA1 , RWA2 
It RWA3, ST 10 , STU, ST12, ST13, ISG1, ISG2, OR ISG3. */) 

GO fO 99 
WR ITE ( 6 , 107 ) 

FORMAT!/ 4X , • THE WALL CONSTRUCTION OF A SEGMENT CANNOT BE IDENTIF 
1 1 ED AS SING, EQUA, UNEO, OR BLAN.*/) 


GO TO 99 

8 WRITE_<6_, 108) 

"108 FORMAT!/' AX, 'THE TYPE OF TEMPERATURE INPUT FOR A SEGMENT CANNOT B 
IE IDENTIFIED AS THST, NOTH, THCN , OR THIN.*/) 

GO TO 99" " 

9 WR ITE 1 6 , 109 ) 


109 FORMAT!/ 4X,‘THE WAFFLE GRID SPACING IS ZERO.'/) 
GO TO 99 

10 WR ITE ( 6t 1 10 ) 

110 FORMAT!/ 4X , • THE RING SPACING IS ZERO. 

GO TO 99 

11 WRITE (6,111) 


'/) 


111 FORMAT!/ 4X, 'THE STRINGER SPACING IS ZERO.*/) 

GO JO 99 

12 WRITE! 6, 112) 

112 FORMAT!/ 4X,'THE OUTSIDE SHEET THICKNESS IS ZERO.*/) 
GO TO 99 

13 WR ITE ( 6 , 113) 


1000210 
1000220 
1000230 
1000240 
1 000250 
10 00260 
1000270 
1000280 
1000290 
1000300 
1000310 
1000320 
1000330 
1000340 
1000350 
1000360 
1000370 
1000380 
1000390 
1000400 
1000410 
1000420 
1000430 
1000440 
T000450 
1000460 
1000470 
1000480 
1000490 
1000500 


113 FORMAT!/ 4 X.'THE CORE THICKNESS IS ZERO.'/) 
GO TO 99 

14 WRITE (6, 114) 

UA FOR MAT !/ 4X,*THE SHEET THICKNESS IS ZERO.*/) 
""GO" TO 99 

15 WR ITE (6,115) . 


1000510 

1000520 

1000530 

1000540 

1000550 

1000560 


115 FORMAT!/ 4X,'THE INSIDE SHEET THICKNESS IS ZERO.*/) 
GO TO 99 

16 WRITE (6,116) 

116 FORMAT!/ 4X,*THE Kll STIFFNESS PARAMETER IS ZERO.'/) 


1000570 

1000580 

1000590" 

1000600 
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GO TO 99 



17 

WRITE ( 6 , 

117) 


117 

FORMAT!/ 

AX, 

•THE 1 


GO TO 99 



18 

WR ITE ! 6, 

118) 


118 

FORMAT! / 

AX, 

•THE 1 


GO TO 99 



19 

WRITEI6, 

119) 


119 

FORMAT! / 

AX, 

•THE 1 


GO TO 99 



20 

WR ITE (6 , 

120) 


120 

FORMAT!/ 

AX, 

•THE 1 


GO TO 99 



21 

WRITEI6, 

121) 


121 

FORMAT! / 

AX, 

'THE 1 


GO TO 99 



22 

WR ITE (6 , 

122) 


122 

FORMAT!/ 

AX, 

'THE 1 


GO TO 99 



23 

WRITE (6 , 

123) 


123 

FORMAT!/ 

AX, 

•THE 1 


GO TO 99 



2A 

WR I TE ( 6, 

12A ) 


12A 

FORMAT!/ 

AX, 

•THE 1 


GO TO 99 



25 

WR ITE (6 , 

125) 


125 

FORMAT!/ 

AX, 

•THE 1 


GO TO 99 



26 

WR I TE ( 6 » 

126) 


126 

FORMAT!/ 

AX, 

•THE 1 


1EING EITHER ISOT, 1 


GO TO 99 



27 

WR I TE ( 6 , 

127) 


127 

FORMAT!/ 

AX, 

•THE 1 


IE, OR FOUR.'/ 

1 


GO TO 99 



28 

WR I TE ( 6, 

128) 


128 

FORMAT!/ 

AX, 

•THE 


1 material PROPERTY 


2.'/) 




GO TO 99 



29 

WR ITE ! 6 , 

129) 


129 

FORMAT! / 

AX, 

•THE 


PARAMETER 

IS 

ZERO. •/ ) 

1000610 

1000620 

1000630 

PARAMETER 

IS 

ZERO. •/ ) 

10006AO 

1000650 

1000660 

PARAMETER 

IS 

ZERO.*/ ) 

1000670 

1000680 

1000690 

PARAMETER 

I S 

ZERO. •/ ) 

1000700 

1000710 

1000720 

PARAMETER 

IS 

ZERO. •/) 

1000730 

1000740 

1000750 

PARAMETER 

IS 

ZERO. •/ ) 

1000760 

1000770 

1000780 

PARAMETER 

IS 

ZERO. •/ ) 

1000790 

1000800 

1000810 

PARAMETER 

IS 

ZERO. V ) 

1000820 
1000830 
1 000840 

PARAMETER 

IS 

ZERO.'/) 

1000850 

1000860 

1000870 

RECOGNIZE 

THE HARDENING 

1000880 

1000890 

CLUE AS B 

/) 

CLUES CAN 

1 ONLY BE ZERO, 

1000920“ 
1000930 
BLANK, ON 1000940 


1000950 
1000960 
1000970 

AX , • THE INTERPOLATED VALUE OF TEMPERATURE FOR USE IN THE 1000980 
BLE IS LESS THAN THE SECOND TEMPERATURE VALUE 1000990 


1 MATERIAL PROPERTY TABLE IS GREATER THAN THE LAST VALUE OF TEMPERA 
2TURE • ' / ) 


GO TO 99 

30 WRITE(6,yO) 

130 FORMAT!/ AXY'FOR KINEMATIC LINKS BETWEEN SEGMENTS, THE DEPENDENT 
1 JOINT NUMBER MUST BE GREATER THAN THE INDEPENDENT JOINT NUMBER.'/) 

GO TO 99 

31 WR ITE1 6 ,1 31) 

131 FORMAT (/ AX,*' J-TH JOINTS ON SUCCESSIVE INTER-REGION KINEMATIC LIN 

IK CARDS MUST BE IN INCREASING ORDER.'/) 

GO TO 99 

32 WR ITE 1 6, 132 ) 

132 FORMAT!/ AX, • TEMPERATURE VALUES (COLUMNS 2 THRU END) IN THE MATER 
UAL PROPERTY TABLE MUST BE IN INCREASING ORDER.'/) 


1001000 
1001C10 
1001020 
1001030 
1001040 
100 1050 
1 00 1060 
1001070 
1OO1O80 
1001090 
1001100 
1001110 
1001120 ' 
1001130 
1001140 
1001150 
1001160 
1001170 


GO TO 99 1001180 

33 WRITE 1 6 , 1 33 ) 1001190 

133 FORMAT!/ AX, 'FOR AN ANNULAR PLATE NEAR THE AXIS OF REVOLUTION, TH 1001200 
IE ENO POINT LOCATIONS SHOULD BE IN A RATIO BETWEEN .01 AND 100.'/) 1001210 


46 



GO TO 99 1001220 

34 WRITE(6,134) 1001230 

134 FORMAT!/ 4X , • DEGREE S OF FREEDOM OF DEPENDENT (J) JOINT OF KINEHAT 1001240 

1IC LINKS MUST BE "ZEROED OUT".*/) 1001250 

GO TO 99 1001260 

35 WRITE<6,135) 1 CO 1 270 

135 FORMAT!/ 4X , • TEMPE RA TURE AND LOAO CLUES ARE INCONSISTENT.*/) 100128C 

GO TO 99 1001290 

36 WRITEI6.136) 10013C0 

136 FORMAT!/ 4X » • THE COMBINATION OF AN ORTHOTROPIC MATERIAL ANU THE I 
ISOTROPIC HAR0EN1NG RULE IS NOT PRESENTLY ALLOWED.*/) 

GO TO 99 1001330 

37 WRITEI6.137) 1001340 

137 FORMAT!/ 4X * * THE NUMBER OF REGION RINGS EXCEEDS 28.*/) 1001350 

GO TO 99 1001360 

38 WR I TE 1 6 1 138 ) 1001370 

138 FORMAT!/ 4X # ' THE NUMBER OF STRUCTURE RINGS EXCEEDS 28.*/) 1001380 

GO TO 99 1001390 

39 WRITE! 6, 139) 1001400 

139 FORMAT!/ 4X,*THE NUMBER OF GEOMETRY INPUT POINTS EXCEEDS 14.*/) 1001410 

GO TO 99' 

40 WRITE; (6, 140) 


140 FORMAT!/ 4X , *P LAST IC l TY ANALYSIS FOR THE STIFFNESS CLUE WORDS RWA 
IF OR ST 10 IS INVALID.*/) 

99 RETURN 
END 


1001420 

1001430 



SECTION 2 
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